      ******************************************************************
       IDENTIFICATION DIVISION.
      ******************************************************************
       PROGRAM-ID.   P231EDIT.
       DATE-WRITTEN. SEPT, 1982.
       DATE-COMPILED.
      ******************************************************************
      *                                                                *
      *    THIS PROGRAM IS A COPY OF PROGRAM P231TE1Q THAT WAS         *
      *    MODIFIED FOR THE CREATION OF THE "NOVA EDIT REPORTS" FOR    *
      *    THE PRODUCT LINE SYSTEM ADMINISTRATORS.                     *
      *                                                                *
      *    THIS PROGRAM READS THE FDAT INPUT CODE TABLES AND EDITS     *
      *    THEM, CREATING THE INTERNAL TABLES FOR USE BY THE OTHER     *
      *    PROGRAMS IN THE FDAT BATCH REPORTING SYSTEM.                *
      *                                                                *
      *----------------------------------------------------------------*
      *                                                                *
      *    INPUTS:                                                     *
      *                                                                *
      *     (01).  CURRENT GENERAL LEDGER MASTER FILE                  *
      *            ( DD=GLMAST   DSN=J231SC.MASTER.DISKCOPY  )         *
      *                                                                *
      *     (02).  FDAT MNEMONIC FILE (UNLOADED FROM DB2 DATABASE)     *
      *            ( DD=MNEMONIC DSN=J231SC.FDAT.MNEMONIC(0) )         *
      *                                                                *
      *     (03).  FDAT DISTRIBUTION FILE (UNLOADED FROM DB2 DATABASE) *
      *            ( DD=INDIST   DSN=J231SC.FINRPT.DISTBL_(0))         *
      *                                                                *
      *     (04).  FDAT BOOK TABLE FILE (UNLOADED FROM DB2 DATABASE)   *
      *            ( DD=INBOOK   DSN=J231SC.FDAT.BOOK(0)     )         *
      *                                                                *
      *     (05).  FDAT REPORT TABLE FILE (UNLOADED FROM DB2 DATABASE) *
      *            ( DD=INREPORT DSN=J231SC.FDAT.RPT(0)      )         *
      *                                                                *
      *     (06).  FDAT ORGANIZATION FILE (UNLOADED FROM DB2 DATABASE) *
      *            ( DD=INORG    DSN=J231SC.FDAT.ORG(0)      )         *
      *                                                                *
      *     (07).  FDAT REGION TABLE FILE (UNLOADED FROM DB2 DATABASE) *
      *            ( DD=INREG    DSN=J231SC.FDAT.REG(0)      )         *
      *                                                                *
      *     (08).  FDAT LINE TABLE  FILE (UNLOADED FROM DB2 DATABASE)  *
      *            ( DD=INLINE   DSN=J231SC.FDAT.LINE(0)     )         *
      *                                                                *
      *     (09).  FDAT COLUMN TABLE FILE (UNLOADED FROM DB2 DATABASE) *
      *            ( DD=INCOL    DSN=J231SC.FDAT.COL(0)      )         *
      *                                                                *
      *     (10).  FDAT PRIME TABLE FILE (UNLOADED FROM DB2 DATABASE)  *
      *            ( DD=INPRIME  DSN=J231SC.FDAT.PRIME(0)    )         *
      *                                                                *
      *----------------------------------------------------------------*
      *                                                                *
      *    OUTPUTS:                                                    *
      *                                                                *
      *    PRINTER  - TABLE EDITS REPORT                               *
      *    PRINTER2 - BOOK TABLE OF CONTENTS REPORT                    *
      *    ERRORS   - SUMMARIZED LIST OF EDIT ERRORS                   *
      *    CTF      -                                                  *
      *    BDX      -                                                  *
      *    DBF      -                                                  *
      *    PXT      -                                                  *
      *    ORG      -                                                  *
      *    REG      -                                                  *
      *    ORC      -                                                  *
      *    RDF      -                                                  *
      *    TCM      -                                                  *
      *    DTF      -                                                  *
      *    EXB      -                                                  *
      *    LCF      -                                                  *
      *    LDF      -                                                  *
      *    CBF      -                                                  *
      *    OCF      -                                                  *
      *    RCF      -                                                  *
      *    PCF      -                                                  *
      *                                                                *
      *----------------------------------------------------------------*
      *                                                                *
      * CHANGES:                                                       *
      *                                                                *
      *----------------------------------------------------------------*
      * 04/01/95  ABLMSC  - PROGRAM NAME WAS CHANGED FROM P231TE1N TO  *
      *           P231TE1Q.  THE PROGRAM WAS UPGRADED TO COBOL II SO   *
      *           ALL OF THE INTERNAL CODE TABLE LIMITS COULD BE       *
      *           INCREASED.  ALL REFERENCES TO "BDAM" FILES NO LONGER *
      *           APPLY, BUT THE NAMES WERE NOT CHANGED IN ORDER TO    *
      *           PROTECT THE INNOCENT.                                *
      *----------------------------------------------------------------*
      * 041092  LENNY  NEW FRS PROGRAMS TO READ PLAN DATA FROM MASTER  *
      *                FILE.  PROGRAM CHANGED FROM P23TE1X TO P231TE1Q.*
      *----------------------------------------------------------------*
      *  5/6/87 SPC  DUE TO 12/13 PERIOD CONVERSION EXPANDED MNEMONIC  *
      *              TABLE ALSO MODIFY THE LOGIC TO HANDLE THIS CHANGE.*
      *              INCREASED PERIOD MNEMONIC MAX TO 256.             *
      *              ADD 'Z' MNEMONIC FOR FUTURE PERIOD FACASTING FOR  *
      *              ASIA ONLY.                                        *
      *----------------------------------------------------------------*
      *  83516 DKB  ADDED ADDIT'L MNEMONIC LOGIC FOR HANDLING          *
      *        ABSOLUTE MNEMONICS (NOT RELATIVE TO CURRENT PERIOD).    *
      *        THIS INCLUDED CONVERTING THE MNEMONIC COPYLIB TO        *
      *        A FILE WHICH IS READ IN TO CREATE 2 TABLES.             *
      *----------------------------------------------------------------*
      *  83531 DKB   ADDITIONS AND CHANGES TO MODIFY 'REPORT           *
      *        DEFINTITION TABLE ENTRIES' REPORT TO HANDLE BOTH        *
      *        THE 2 ADDITIONAL PRINTABLE COLUMNS AND THE NEW          *
      *        42 UNPRINTABLE COLUMNS.                                 *
      *----------------------------------------------------------------*
      *  83531 DKB  SEVERAL LOGIC ALTERATIONS TO ALLOW FOR ADDIT'L     *
      *        COLUMNS.                                                *
      *----------------------------------------------------------------*
      *  83601 DKB  ADDED MNEMONIC LOGIC FOR HANDLING 'EXCEPTION'      *
      *        TYPE MNEMONICS -- 'ACY','AC1','PCY','PC1','YA0','YA1'.  *
      *----------------------------------------------------------------*
      * 83171 (83620) DKB  ADDED EDIT CHECK FOR NONCONSECUTIVE         *
      *               TYPE 1 RECORDS.  ALSO CHANGED COPYLIB MEMBERS    *
      *               TO Z.                                            *
      *----------------------------------------------------------------*
      * 83174 (83623) DKB  ADDED EDIT CHECK FOR CALCULATION TABLE      *
      *               OVERFLOW.                                        *
      *----------------------------------------------------------------*
      *               CPL - CHANGED CONTENTS OF THE FIRST AND THIRD    *
      *               ORC RECORDS FOR PROPER HANDLING OF ORG/REG       *
      *               COMBINATIONS FOR FORECAST FIGURES. THE SYSTEM    *
      *               WAS ONLY HANDLING REG ID INDEX 0001, NO OTHERS.  *
      *----------------------------------------------------------------*
      *   CPL - MADE CHANGES FOR THE HANDLING OF SUBACCOUNTS IN THE    *
      *         PRIME TABLE. ALSO CHANGED LRECL OF PXT.                *
      *----------------------------------------------------------------*
      *   CPL - FIXED LINE CALC FLAG IN '6080-FORMAT...'  -  WAS NOT   *
      *         PERFORMING CONSTANT CALCS ON LINES WITHOUT 'LXXX'      *
      *         CALCS.                                                 *
      *----------------------------------------------------------------*
      *   CPL - CHANGED CHECK ON MAX-LINE-TBL AND MAX-COL-TBL TO       *
      *         'NOT >' FROM '<'   -  ALSO RAISED THE LIMIT OF LINE    *
      *         TABLES TO 40.  ALSO ELIMINATED PRINTING ALL 56         *
      *         COLUMNS IN REPORT TABLE.                               *
      *----------------------------------------------------------------*
      *   DKB - CHANGED NUMBER OF ALLOWED ENTRIES ON THE ORG TABLE     *
      *         FROM 300 TO 1000. ALSO ADDED FORMAT L. ALSO            *
      *         CHANGED NUMBER OF ALLOWED ENTRIES FOR THE REGION       *
      *         TABLE TO 200 FROM 100 AND REDUCED THE NUMBER OF        *
      *         ALLOWED REGION TABLES FROM 10 TO 5.                    *
      *----------------------------------------------------------------*
      *   CPL - MANY CHANGES FOR NSGE INSTALLATION :                   *
      *     1)  ALLOWED O/P/R OPERATORS ON THE COLUMN TABLE, WHICH     *
      *         PUTS DATA IN THE COLUMN THAT IS DIFFERENT THAN THE     *
      *         COLUMN TABLE TYPE.  THIS ALLOWS YOU TO PRINT A REPORT  *
      *         SHOWING PRIMES ON THE LINES AND THEN A COLUMN OF       *
      *         PERCENTAGES EACH LINE IS OF (SAY) NET SALES (WHICH IS  *
      *         A PRIME.  NEEDED FOR NSGE'S REGION P&L FORMAT.         *
      *     2)  CHANGED THE PRIME TABLE EDIT TO ALLOW FOR 'ALPHABETIC' *
      *         PRIMES, REAL PRIMES ON G/L THAT BEGIN WITH A LETTER.   *
      *         PREVIOUSLY THESE WERE TREATED AS 'SUBTOTAL' PRIMES.    *
      *         THIS WAS NEEDED FOR SEPARATION OF THE SANTA CLARA      *
      *         MARKET P&L PRIMES FROM THE LIVE NSGE PRIMES.  THE      *
      *         LETTER 'A' MUST BE IN THE BALANCE SHEET FLAG TO LET THE*
      *         ENTRY PASS THE EDIT.                                   *
      *----------------------------------------------------------------*
      *  CPL    CHANGED LINE TABLE EDIT TO ALLOW FOR COLUMN            *
      *         BLANKOUT & SIGN REVERSAL ON UNPRINTABLE COLUMNS        *
      *                                                                *
      *----------------------------------------------------------------*
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT IN-DIST-FILE         ASSIGN TO UT-S-INDIST.
           SELECT IN-BOOK-FILE         ASSIGN TO UT-S-INBOOK.
           SELECT IN-REPORT-FILE       ASSIGN TO UT-S-INREPORT.
           SELECT IN-ORG-FILE          ASSIGN TO UT-S-INORG.
           SELECT IN-REG-FILE          ASSIGN TO UT-S-INREG.
           SELECT IN-LINE-FILE         ASSIGN TO UT-S-INLINE.
           SELECT IN-COL-FILE          ASSIGN TO UT-S-INCOL.
           SELECT IN-PRIME-FILE        ASSIGN TO UT-S-INPRIME.
           SELECT GL-MASTER-FILE       ASSIGN TO UT-S-GLMAST.
           SELECT CONTROL-TOTAL-FILE   ASSIGN TO UT-S-CTF.
           SELECT DATE-FILE            ASSIGN TO UT-S-DTF.
           SELECT BOOK-TO-DIST-FILE    ASSIGN TO UT-S-BDX.
           SELECT DIST-BOOK-FILE       ASSIGN TO UT-S-DBF.
           SELECT PRIME-XREF-TBL-FILE  ASSIGN TO UT-S-PXT.
           SELECT ORG-REG-COMBO-FILE   ASSIGN TO UT-S-ORC.
           SELECT ORG-TABLE-FILE       ASSIGN TO UT-S-ORG.
           SELECT REG-TABLE-FILE       ASSIGN TO UT-S-REG.
           SELECT LINE-DESC-FILE       ASSIGN TO UT-S-LDF.
           SELECT LINE-CALC-FILE       ASSIGN TO UT-S-LCF.
           SELECT COL-BDAM-FILE        ASSIGN TO UT-S-CBF.
           SELECT RPT-DEF-FILE         ASSIGN TO UT-S-RDF.
           SELECT MNEMONIC-FILE        ASSIGN TO UT-S-MNEMONIC.
           SELECT CALC-WORK-FILE       ASSIGN TO UT-S-CALCWORK.
           SELECT ORG-CALC-FILE        ASSIGN TO UT-S-OCF.
           SELECT REG-CALC-FILE        ASSIGN TO UT-S-RCF.
           SELECT PRIME-CALC-FILE      ASSIGN TO UT-S-PCF.
           SELECT EXP-BOOK-DEF-FILE    ASSIGN TO UT-S-EXB.
           SELECT TBL-OF-CONT-FILE     ASSIGN TO UT-S-TCM.
           SELECT WORK-FILE            ASSIGN TO UT-S-WRKFILE.
           SELECT WORK-FILE-2          ASSIGN TO UT-S-WRKFILE2.
           SELECT WORK-FILE-3          ASSIGN TO UT-S-WRKFILE3.
           SELECT SORT-FILE            ASSIGN TO UT-S-SORTWK.
           SELECT PRINTER              ASSIGN TO UT-S-PRINTER.
           SELECT PRINTER2             ASSIGN TO UT-S-PRINTER2.
           SELECT ERRORS               ASSIGN TO UT-S-ERRORS.
      /
       DATA DIVISION.

       FILE SECTION.

       FD  IN-DIST-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-DIST-REC              PIC X(80).


       FD  IN-BOOK-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-BOOK-REC              PIC X(80).


       FD  IN-REPORT-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-REPORT-REC            PIC X(80).


       FD  IN-ORG-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-ORG-REC               PIC X(80).


       FD  IN-REG-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-REG-REC               PIC X(80).


       FD  IN-LINE-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-LINE-REC              PIC X(80).


       FD  IN-COL-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-COL-REC               PIC X(80).
      /

       FD  IN-PRIME-FILE
           LABEL RECORDS ARE STANDARD
           BLOCK CONTAINS    0  RECORDS
           RECORD CONTAINS  80  CHARACTERS.
       01  FD-IN-PRIME-REC             PIC X(80).


       COPY C230NGLM.
      /
       COPY C231FDTF.
       COPY C231FCTF.
       COPY C231FBDX.
       COPY C231FDBF.
       COPY C231FPXT.
       COPY C231FORC.
       COPY C231FOTF.
      /
       COPY C231FRTF.
       COPY C231FLDF.
       COPY C231FLCF.
       COPY C231FCBF.
       COPY C231FRDF.
      /
       COPY C231FEXB.
       COPY C231FTCM.
       COPY C231FOCF.
       COPY C231FRCF.
       COPY C231FPCF.
       COPY C231FPMT.
      /

       FD  CALC-WORK-FILE
           LABEL RECORDS ARE STANDARD
           RECORD CONTAINS  17  CHARACTERS
           BLOCK CONTAINS  0  RECORDS.
       01  FD-CALC-WORK-REC.
           05  FILLER                  PIC X(17).

       FD  WORK-FILE
           LABEL RECORDS ARE STANDARD
           RECORD CONTAINS  120  CHARACTERS
           BLOCK CONTAINS  0  RECORDS.
       01  FD-WORK-REC.
           05  FILLER                  PIC X(120).

       FD  WORK-FILE-2
           LABEL RECORDS ARE STANDARD
           RECORD CONTAINS  120  CHARACTERS
           BLOCK CONTAINS  0  RECORDS.
       01  FD-WORK-FILE-2-REC.
           05  FILLER                  PIC X(120).

       FD  WORK-FILE-3
           LABEL RECORDS ARE STANDARD
           RECORD CONTAINS  120  CHARACTERS
           BLOCK CONTAINS  0  RECORDS.
       01  FD-WORK-FILE-3-REC.
           05  FILLER                  PIC X(120).

       FD  PRINTER
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS  133  CHARACTERS.
       01  FD-PRINTER-REC.
           05  FILLER                  PIC X(01).
           05  FD-PRINTER-AREA         PIC X(132).

       FD  PRINTER2
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS  133  CHARACTERS.
       01  FD-PRINTER2-REC.
           05  FILLER                  PIC X(01).
           05  FD-PRINTER2-AREA        PIC X(132).

       FD  ERRORS
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS  133  CHARACTERS.
       01  FD-ERRORS-REC.
           05  FILLER                  PIC X(01).
           05  FD-ERROR-AREA           PIC X(132).
      /

       SD  SORT-FILE.
       01  SD-SORT-WORK-REC.
           05  SD-SORT-KEY             PIC X(11).
           05  FILLER                  PIC X(109).
      **************************************************************
      *    SORT WORK FILE RECORD DESCRIPTIONS
      **************************************************************
      **************************************************************
      *    SORT RECORD FOR BUILDING BOOK-TO-DIST XREF FILE
      *    AND SELECTED BOOK TABLE
      **************************************************************
       01  SD-BOOK-REC.
           05  SD-BOOK-ID                  PIC X(04).
           05  SD-DIST-INDEX               PIC 9(08) COMP.
           05  SD-BOOK-COPIES              PIC 9(02).
           05  SD-BOOK-BURST-FLAG          PIC X(01).
           05  FILLER                      PIC X(10).

      **************************************************************
      *    SORT RECORD FOR BUILDING SELECTED REPORT TABLE
      **************************************************************
       01  SD-REPORT-REC.
           05  SD-REPORT-ID                PIC X(04).
           05  FILLER                      PIC X(14).

      **************************************************************
      *    SORT RECORDS FOR ORG TABLE CHECKS
      **************************************************************
       01  SD-ORG-REC.
           05  SD-ORG-ID                   PIC X(02).
           05  SD-ORG-MNEM                 PIC X(04).
           05  SD-ORG-ROLLUP-KEY           PIC X(22).
           05  SD-ORG-ID-INDEX             PIC 9(04) COMP.
           05  SD-ORG-ENTRY-COUNT          PIC 9(04) COMP.


      **************************************************************
      *    SORT RECORDS FOR REG TABLE CHECKS
      **************************************************************
       01  SD-REG-REC.
           05  SD-REG-ID                   PIC X(02).
           05  SD-REG-MNEM                 PIC X(04).
           05  SD-REG-ROLLUP-KEY           PIC X(16).
           05  SD-REG-SEARCH-KEY           PIC X(06).
           05  SD-REG-ID-INDEX             PIC 9(04) COMP.
           05  SD-REG-ENTRY-COUNT          PIC 9(04) COMP.

      /
      **************************************************************
      *    SORT RECORD FOR PRIME ID TABLE (BINARY SEARCH)
      **************************************************************
       01  SD-PRIME-REC.
           05  SD-PRIME-ID                 PIC X(04).
           05  SD-PRIME-INDEX              PIC 9(04) COMP.
           05  FILLER                      PIC X(12).

      **************************************************************
      *    SORT RECORD FOR CALC REC CREATION
      **************************************************************
       01  SD-CALC-REC.
           05  SD-CALC-KEY                 PIC X(05).
           05  FILLER                      PIC X(13).

      **************************************************************
      *    SORT RECORD FOR ORG-REG COMBINATION FILE
      **************************************************************
       01  SD-ORC-REC.
           05  SD-ORC-KEY.
               10  SD-ORC-REC-TYPE         PIC X(01).
               10  SD-ORC-ORG-REG.
                   15  SD-ORC-ORG-ID-INDEX PIC 9(04) COMP.
                   15  SD-ORC-REG-ID-INDEX PIC 9(04) COMP.
           05  FILLER                      PIC X(12).

      **************************************************************
      *    SORT RECORD FOR EXPANDED BOOK FILE - MATCH IN FORMATTER
      **************************************************************
       01  SD-EXB-REC.
           05  SD-EXB-KEY                  PIC X(06).
           05  FILLER                      PIC X(12).

      **************************************************************
      *    SORT RECORD FOR TABLE OF CONT FILE (BY BOOK INDEX)
      **************************************************************
       01  SD-TCM-REC.
           05  SD-TCM-KEY                  PIC X(05).
           05  FILLER                      PIC X(102).

      /**************************************************************
       WORKING-STORAGE SECTION.
      **************************************************************

      ****************** COUNTERS AND SWITCHES **********************

       01  FILE-STATUS-SWITCHES.
           05  IN-DIST-FILE-STATUS     PIC X(03)    VALUE SPACES.
               88  END-OF-DIST-FILE                 VALUE 'EOF'.
           05  IN-BOOK-FILE-STATUS     PIC X(03)    VALUE SPACES.
               88  END-OF-BOOK-FILE                 VALUE 'EOF'.
           05  IN-REPORT-FILE-STATUS   PIC X(03)    VALUE SPACES.
               88  END-OF-REPORT-FILE               VALUE 'EOF'.
           05  IN-ORG-FILE-STATUS      PIC X(03)    VALUE SPACES.
               88  END-OF-ORG-FILE                  VALUE 'EOF'.
           05  IN-REG-FILE-STATUS      PIC X(03)    VALUE SPACES.
               88  END-OF-REG-FILE                  VALUE 'EOF'.
           05  IN-LINE-FILE-STATUS     PIC X(03)    VALUE SPACES.
               88  END-OF-LINE-FILE                 VALUE 'EOF'.
           05  IN-COL-FILE-STATUS      PIC X(03)    VALUE SPACES.
               88  END-OF-COL-FILE                  VALUE 'EOF'.
           05  IN-PRIME-FILE-STATUS    PIC X(03)    VALUE SPACES.
               88  END-OF-PRIME-FILE                VALUE 'EOF'.
           05  SORT-FILE-STATUS        PIC X(03)    VALUE SPACES.
               88  END-OF-SORT-FILE                 VALUE 'EOF'.
           05  WORK-FILE-STATUS        PIC X(03)    VALUE SPACES.
               88  END-OF-WORK-FILE                 VALUE 'EOF'.
           05  GL-FILE-STATUS          PIC X(03)    VALUE SPACES.
               88  END-OF-GL                        VALUE 'EOF'.
           05  IN-MNEMONIC-FILE-STATUS PIC X(03)    VALUE SPACES.
               88  END-OF-MNEMONIC-FILE             VALUE 'EOF'.
      /********************** WORK FIELDS ***************************
       01  WORK-FIELDS.
           05  ERROR-COUNT             PIC 9(5) COMP-3 VALUE 0.
           05  MASTER-ERROR-SWITCH     PIC X(01) VALUE 'N'.
           05  BOOK-RPT-ERROR-SWITCH   PIC X(01) VALUE 'N'.
           05  BOOK-FOUND-FLAG         PIC X(01) VALUE ' '.
           05  BOOK-ONES-FLAG          PIC X(01) VALUE 'N'.
           05  BOOK-REC-TYPE-FLAG      PIC X(01) VALUE 'N'.
           05  ORG-RUP-FOUND-SWITCH    PIC X(01) VALUE ' '.
           05  REG-RUP-FOUND-SWITCH    PIC X(01) VALUE ' '.
           05  MNEMONIC-FOUND-FLAG     PIC X(01) VALUE 'N'.
           05  REPORT-REC-COUNT        PIC 9     VALUE ZERO.
           05  SAVE-ORG-KEY            PIC X(04) VALUE SPACES.
           05  SAVE-ORG-ID             PIC X(02) VALUE SPACES.
           05  SAVE-ORG-ID-INDEX       PIC 9(04) VALUE ZERO.
           05  SAVE-ORG-LEVEL          PIC 9(04) VALUE ZERO.
           05  SAVE-ORG-MNEM           PIC X(04) VALUE SPACES.
           05  SAVE-ORG-ROLLUP-KEY     PIC X(22) VALUE SPACES.
           05  SAVE-REG-ID             PIC X(02) VALUE SPACES.
           05  SAVE-REG-ID-INDEX       PIC 9(04) VALUE ZERO.
           05  SAVE-REG-LEVEL          PIC 9(04) VALUE ZERO.
           05  SAVE-REG-MNEM           PIC X(04) VALUE SPACES.
           05  SAVE-REG-SEARCH-KEY     PIC X(06) VALUE SPACES.
           05  SAVE-REG-ROLLUP-KEY     PIC X(16) VALUE SPACES.
           05  CHECK-ORG-ID            PIC X(04) VALUE SPACES.
           05  CHECK-REG-ID            PIC X(04) VALUE SPACES.
           05  CHECK-ORG-ID-INDEX      PIC 9(04) COMP SYNC VALUE 0.
           05  CHECK-REG-ID-INDEX      PIC 9(04) COMP SYNC VALUE 0.
           05  ORG-ID-COUNT            PIC 9(04) COMP SYNC.
           05  ORG-ENTRY-COUNT         PIC 9(04) COMP SYNC.
           05  REG-ID-COUNT            PIC 9(04) COMP SYNC.
           05  REG-ENTRY-COUNT         PIC 9(04) COMP SYNC.
           05  SAVE-LINE-ID            PIC X(03) VALUE SPACES.
           05  CHECK-LINE-ID           PIC X(03) VALUE SPACES.
           05  SAVE-COL-ID             PIC X(03) VALUE SPACES.
           05  CHECK-COL-ID            PIC X(03) VALUE SPACES.
           05  OTF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  RTF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  REPORT-ORG-COUNT        PIC 9(03) COMP-3 VALUE ZERO.
           05  REPORT-REG-COUNT        PIC 9(03) COMP-3 VALUE ZERO.
           05  REPORT-PRIME-COUNT      PIC 9(03) COMP-3 VALUE ZERO.
           05  DIST-COUNT              PIC 9(05) COMP-3 VALUE ZERO.
           05  BOOK-COUNT              PIC 9(05) COMP-3 VALUE ZERO.
           05  REPORT-COUNT            PIC 9(05) COMP-3 VALUE ZERO.
           05  LINE-COUNT-CT           PIC 9(05) COMP-3 VALUE ZERO.
           05  COL-COUNT               PIC 9(05) COMP-3 VALUE ZERO.
           05  ORG-COUNTS.
               10  ORG-COUNT-LEVELS OCCURS 4 TIMES.
                   15  ORG-COUNT           PIC 9(05) COMP-3.
           05  REG-COUNTS.
               10  REG-COUNT-LEVELS OCCURS 5 TIMES.
                   15  REG-COUNT           PIC 9(05) COMP-3.
           05  PRIME-COUNT             PIC 9(05) COMP-3 VALUE ZERO.
           05  CT                      PIC 9(05) COMP-3 VALUE ZERO.
           05  LCF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  LDF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  CBF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  PCF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  RCF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  OCF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  DTF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  BDX-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  DBF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  EXB-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  PXT-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  ORC-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  RDF-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  TCM-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  BXD-COUNT               PIC 9(07) COMP-3 VALUE ZERO.
           05  DSP                     PIC 9(05) COMP-3 VALUE ZERO.
           05  LINE-COUNT              PIC 9(03) COMP-3 VALUE 99.
           05  LINE-COUNT-2            PIC 9(03) COMP-3 VALUE 99.
           05  PAGE-COUNT              PIC 9(03) COMP-3 VALUE ZERO.
           05  PAGE-COUNT-2            PIC 9(03) COMP-3 VALUE ZERO.
           05  MNEMONIC-INDEX          PIC 9(04) COMP SYNC VALUE 0.
           05  POINTER-INDEX           PIC 9(04) COMP SYNC VALUE 0.
           05  ORG-ID-INDEX            PIC 9(04) COMP SYNC VALUE 0.
           05  ORG-ENTRY-INDEX         PIC 9(04) COMP SYNC VALUE 0.
           05  ORG-ROLLUP-INDEX        PIC 9(04) COMP SYNC VALUE 0.
      /*************************************************************
      *    COUNT MASK AREA
      **************************************************************
       01  COUNT-MASK.
           05  FILLER                  PIC 9(05) COMP-3 VALUE ZERO.
           05  FILLER                  PIC 9(05) COMP-3 VALUE ZERO.
           05  FILLER                  PIC 9(05) COMP-3 VALUE ZERO.
           05  FILLER                  PIC 9(05) COMP-3 VALUE ZERO.
           05  FILLER                  PIC 9(05) COMP-3 VALUE ZERO.
      /*************************************************************
      *    DTD RECORD WORK AREA
      **************************************************************
       01  WORK-RECORD.
           05  FILLER                  PIC X(08).
           05  WORK-PERIOD-MNEMONIC    PIC X(03).
           05  WORK-DEFAULT-HEADING-1  PIC X(09).
           05  WORK-DEFAULT-HEADING-2  PIC X(09).
           05  FILLER                  PIC X(03).
           05  WORK-REL-FLAG           PIC X(01).
           05  FILLER                  PIC X(05).
           05  WORK-CALC-PARMS.
               10  WORK-AVG-FLAG       PIC X(01).
               10  FILLER              PIC X(05).
               10  WORK-FCST-FLAG      PIC X(01).
               10  FILLER              PIC X(06).
               10  WORK-BEG-INDEX      PIC 9(02).
               10  FILLER              PIC X(04).
               10  WORK-END-INDEX      PIC 9(02).
               10  FILLER              PIC X(04).
               10  WORK-NO-REPS        PIC 9(02).
               10  FILLER              PIC X(04).
               10  WORK-DIVISOR        PIC 9(02).
               10  FILLER              PIC X(05).
               10  WORK-BAL-INDEX      PIC 9(02).
               10  FILLER              PIC X(02).
      /*************************************************************
      *    EXTERNAL TABLE RECORD DESCRIPTIONS
      **************************************************************
      **************************************************************
      *    DISTRIBUTION TABLE RECORD FORMATS
      **************************************************************
       01  IN-DIST-REC.
           05  IN-DIST-REC-TYPE-1.
               10  IN-DIST-ID.
                   15  IN-DIST-ID-1            PIC X(01).
                   15  FILLER                  PIC X(02).
               10  IN-DIST-REC-TYPE        PIC X(01).
               10  IN-DIST-NAME            PIC X(76).
           05  IN-DIST-REC-TYPE-2  REDEFINES  IN-DIST-REC-TYPE-1.
               10  FILLER                  PIC X(04).
               10  IN-DIST-BOOKS           OCCURS 9 TIMES.
                   15  FILLER              PIC X(01).
                   15  IN-DIST-BOOK-ID     PIC X(04).
                   15  IN-DIST-BOOK-COPIES PIC 9(02).
                   15  IN-DIST-BOOK-COPIES-X  REDEFINES
                         IN-DIST-BOOK-COPIES    PIC X(02).
                   15  IN-DIST-BURST-FLAG  PIC X(01).
               10  FILLER                  PIC X(04).

      **************************************************************
      *    BOOK DEFINITION TABLE RECORD FORMATS
      **************************************************************
       01  IN-BOOK-REC.
           05  IN-BOOK-REC-TYPE-1.
               10  IN-BOOK-ID.
                   15  IN-BOOK-ID-1            PIC X(01).
                   15  FILLER                  PIC X(03).
               10  FILLER                  PIC X(01).
               10  IN-BOOK-REC-TYPE        PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-BOOK-TOC-GEN-FLAG    PIC X(01).
               10  IN-BOOK-TITLE-MEMO      PIC X(72).
           05  IN-BOOK-REC-TYPE-2  REDEFINES  IN-BOOK-REC-TYPE-1.
               10  FILLER                  PIC X(07).
               10  IN-BOOK-PAGE-COUNT      PIC 9(02).
               10  IN-BOOK-TOC-LINE        PIC X(71).
           05  IN-BOOK-REC-TYPE-3  REDEFINES  IN-BOOK-REC-TYPE-2.
               10  FILLER                  PIC X(07).
               10  IN-BOOK-PRINT-SUPP-FLAG PIC X(01).
               10  IN-BOOK-REPORT-ID       PIC X(04)
                                           OCCURS 18 TIMES.
           05  IN-BOOK-REC-TYPE-4  REDEFINES  IN-BOOK-REC-TYPE-3.
               10  FILLER                  PIC X(07).
               10  IN-BOOK-RUP1-MNEMONICS.
                   15  IN-BOOK-RUP1-MNEM   PIC X(03)
                                           OCCURS 11 TIMES.
               10  IN-BOOK-PRIME-RUP1-MNEMS
                          REDEFINES  IN-BOOK-RUP1-MNEMONICS.
                   15  IN-BOOK-RUP1-PRIME  PIC X(04)
                                           OCCURS 8 TIMES.
                   15  FILLER              PIC X(01).
               10  IN-BOOK-RUP2-MNEMONICS.
                   15  IN-BOOK-RUP2-MNEM   PIC X(03)
                                           OCCURS 11 TIMES.
               10  IN-BOOK-PRIME-RUP2-MNEMS
                          REDEFINES  IN-BOOK-RUP2-MNEMONICS.
                   15  IN-BOOK-RUP2-PRIME  PIC X(04)
                                           OCCURS 8 TIMES.
                   15  FILLER              PIC X(01).
               10  FILLER                  PIC X(07).
           05  IN-BOOK-REC-TYPE-5  REDEFINES  IN-BOOK-REC-TYPE-4.
               10  FILLER                  PIC X(07).
               10  IN-BOOK-RUP1-CODES.
                   15  IN-BOOK-RUP1-CODES-AREA OCCURS 11 TIMES.
                       20  IN-BOOK-RUP1-CODE   PIC X(02).
                       20  IN-BOOK-RUP1-SUPP   PIC X(01).
               10  IN-BOOK-RUP1-PRIME-CODES
                         REDEFINES  IN-BOOK-RUP1-CODES.
                   15  IN-BOOK-RUP1-PRIME-AREA OCCURS 8 TIMES.
                       20  IN-BOOK-RUP1-P-CODE PIC X(02).
                       20  FILLER              PIC X(02).
                   15  FILLER                  PIC X(01).
               10  IN-BOOK-RUP2-CODES.
                   15  IN-BOOK-RUP2-CODES-AREA OCCURS 11 TIMES.
                       20  IN-BOOK-RUP2-CODE   PIC X(02).
                       20  IN-BOOK-RUP2-SUPP   PIC X(01).
               10  IN-BOOK-RUP2-PRIME-CODES
                         REDEFINES  IN-BOOK-RUP2-CODES.
                   15  IN-BOOK-RUP2-PRIME-AREA OCCURS 8 TIMES.
                       20  IN-BOOK-RUP2-P-CODE PIC X(02).
                       20  FILLER              PIC X(02).
                   15  FILLER                  PIC X(01).
               10  FILLER                  PIC X(07).
      /*************************************************************
      *    REPORT DEFINITION TABLE RECORD FORMATS
      **************************************************************
       01  IN-REPORT-REC.
           05  IN-REPORT-REC-TYPE-1.
               10  IN-REPORT-ID.
                   15  IN-REPORT-ID-1          PIC X(01).
                   15  FILLER                  PIC X(03).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-REC-TYPE      PIC X(01).
               10  IN-REPORT-REC-TYPE-NUM  REDEFINES
                   IN-REPORT-REC-TYPE      PIC 9(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-PAGE-BREAK    PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-FORMAT        PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-ELIM-FLAG     PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-COL-FLAG      PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-ORG-ID        PIC X(02).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-REG-ID        PIC X(02).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-LINE-ID.
                   15  IN-REPORT-LINE-ID-1     PIC X(01).
                   15  IN-REPORT-LINE-ID-2-3   PIC X(02).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-COL-ID.
                   15  IN-REPORT-COL-ID-1      PIC X(01).
                   15  IN-REPORT-COL-ID-2-3    PIC X(02).
               10  IN-REPORT-TOC-DESC      PIC X(52).
           05  IN-REPORT-REC-TYPE-2  REDEFINES  IN-REPORT-REC-TYPE-1.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-RUP1-TYPE     PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-RUP1-MNEMONICS.
                   15  IN-REPORT-RUP1-MNEM PIC X(04)
                                           OCCURS 13 TIMES.
               10  FILLER                  PIC X(19).
           05  IN-REPORT-REC-TYPE-3  REDEFINES  IN-REPORT-REC-TYPE-2.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-RUP2-TYPE     PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-RUP2-MNEMONICS.
                   15  IN-REPORT-RUP2-MNEM PIC X(04)
                                           OCCURS 13 TIMES.
               10  FILLER                  PIC X(19).
           05  IN-REPORT-REC-TYPE-4  REDEFINES  IN-REPORT-REC-TYPE-3.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-DOLLAR-FLAG   PIC X(01).
               10  FILLER                  PIC X(01).
               10  IN-REPORT-PERIOD-AREA   OCCURS 14 TIMES.
                   15  IN-REPORT-PD-MNEM   PIC X(03).
                   15  FILLER              PIC X(01).
               10  FILLER                  PIC X(15).
           05  IN-REPORT-REC-TYPE-5  REDEFINES  IN-REPORT-REC-TYPE-4.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-TITLE-1       PIC X(73).
           05  IN-REPORT-REC-TYPE-6  REDEFINES  IN-REPORT-REC-TYPE-5.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-TITLE-2       PIC X(73).
           05  IN-REPORT-REC-TYPE-7  REDEFINES  IN-REPORT-REC-TYPE-6.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-TITLE-3-1     PIC X(66).
               10  FILLER                  PIC X(07).
           05  IN-REPORT-REC-TYPE-8  REDEFINES  IN-REPORT-REC-TYPE-7.
               10  FILLER                  PIC X(07).
               10  IN-REPORT-TITLE-3-2     PIC X(66).
               10  FILLER                  PIC X(07).

      /*************************************************************
      *    LINE TABLE RECORD FORMATS
      **************************************************************
       01  IN-LINE-REC.
           05  IN-LINE-HEADER-RECORD.
               10  IN-LINE-ID.
                   15  IN-LINE-ID-BYTE-1       PIC X(01).
                   15  IN-LINE-ID-BYTES-2-3    PIC X(02).
               10  IN-LINE-TYPE            PIC X(01).
               10  IN-LINE-COMMENTS        PIC X(76).
           05  IN-LINE-RECORD  REDEFINES  IN-LINE-HEADER-RECORD.
               10  FILLER                  PIC X(03).
               10  IN-LINE-NUMBER          PIC 9(03).
               10  IN-LINE-NUMBER-X  REDEFINES  IN-LINE-NUMBER.
                   15  IN-LINE-NUMBER-1    PIC X(01).
                   15  IN-LINE-NUMBER-2    PIC X(01).
                   15  IN-LINE-NUMBER-3    PIC X(01).
               10  IN-LINE-DESCRIPTION     PIC X(32).
               10  IN-LINE-EDIT-TYPE       PIC X(01).
               10  IN-LINE-CALCULATION-AREA.
                   15  IN-LINE-CALCULATIONS    OCCURS 8 TIMES.
                       20  IN-LINE-OPERAND     PIC X(04).
                       20  IN-LINE-OPERATOR    PIC X(01).
               10  FILLER                  PIC X(01).

      **************************************************************
      *    COLUMN TABLE RECORD FORMATS
      **************************************************************
       01  IN-COL-REC.
           05  IN-COL-HEADER-RECORD.
               10  IN-COL-ID.
                   15  IN-COL-ID-BYTE-1        PIC X(01).
                   15  IN-COL-ID-BYTES-2-3     PIC X(02).
               10  IN-COL-TYPE             PIC X(01).
               10  IN-COL-COMMENTS         PIC X(76).
           05  IN-COL-RECORD  REDEFINES  IN-COL-HEADER-RECORD.
               10  FILLER                  PIC X(03).
               10  IN-COL-NUMBER           PIC 9(02).
               10  IN-COL-NUMBER-X  REDEFINES  IN-COL-NUMBER.
                   15  IN-COL-NUMBER-1     PIC X(01).
                   15  IN-COL-NUMBER-2     PIC X(01).
               10  IN-COL-DESCRIPTION-1    PIC X(09).
               10  IN-COL-DESCRIPTION-2    PIC X(09).
               10  IN-COL-EDIT-TYPE        PIC X(01).
               10  IN-COL-CALCULATION-AREA.
                   15  IN-COL-CALCULATIONS     OCCURS 11 TIMES.
                       20  IN-COL-OPERAND  PIC X(04).
                       20  IN-COL-OPERATOR PIC X(01).
               10  FILLER                  PIC X(01).

      /*************************************************************
      *    REGION TABLE RECORD FORMATS
      **************************************************************
       01  IN-REG-REC.
           05  IN-REG-HEADER-RECORD.
               10  IN-REG-ID.
                   15  IN-REG-ID-1             PIC X(01).
                   15  FILLER                  PIC X(01).
               10  IN-REG-LEVEL-MNEMONICS.
                   15  IN-REG-LEVEL-MNEM   PIC X(03)
                                           OCCURS 8 TIMES.
               10  FILLER                  PIC X(05).
               10  IN-REG-SEARCH-KEY-FLAGS.
                   15  IN-REG-LOC-FLAG     PIC X(02).
                   15  IN-REG-DIV-FLAG     PIC X(02).
                   15  IN-REG-FAM-FLAG     PIC X(02).
               10  FILLER                  PIC X(01).
               10  IN-REG-TABLE-DESC       PIC X(29).
               10  FILLER                  PIC X(13).
           05  IN-REG-RECORD  REDEFINES  IN-REG-HEADER-RECORD.
               10  FILLER                  PIC X(02).
               10  IN-REG-ROLLUP-KEY       PIC X(24).
               10  IN-REG-ROLLUP-KEY-LEVELS   REDEFINES
                   IN-REG-ROLLUP-KEY       OCCURS 8 TIMES.
                   15  IN-REG-KEY-LITERAL  PIC X(02).
                   15  FILLER              PIC X(01).
               10  IN-REG-ENTRY-MNEM       PIC X(04).
               10  FILLER                  PIC X(01).
               10  IN-REG-SEARCH-KEY.
                   15  IN-REG-LOC          PIC X(02).
                   15  IN-REG-DIV          PIC X(02).
                   15  IN-REG-FAM          PIC X(02).
               10  FILLER                  PIC X(01).
               10  IN-REG-ENTRY-DESC       PIC X(29).
               10  FILLER                  PIC X(13).

      /*************************************************************
      *    ORGANIZATION TABLE RECORD FORMATS
      **************************************************************
       01  IN-ORG-REC.
           05  IN-ORG-HEADER-RECORD.
               10  IN-ORG-ID.
                   15  IN-ORG-ID-1                 PIC X(01).
                   15  FILLER                      PIC X(01).
               10  IN-ORG-LEVEL-MNEMONICS.
                   15  IN-ORG-LEVEL-MNEM       PIC X(03)
                                           OCCURS 11 TIMES.
               10  FILLER                  PIC X(04).
               10  IN-ORG-DEFAULT-FAM      PIC X(02).
               10  FILLER                  PIC X(09).
               10  IN-ORG-TABLE-DESC       PIC X(30).
           05  IN-ORG-3-HEADERS  REDEFINES  IN-ORG-HEADER-RECORD.
               10  IN-ORG-HEADER-RECORD-1  PIC X(30).
               10  IN-ORG-HEADER-RECORD-2  PIC X(17).
               10  IN-ORG-HEADER-RECORD-3  PIC X(33).
           05  IN-ORG-RECORD  REDEFINES  IN-ORG-HEADER-RECORD.
               10  FILLER                  PIC X(02).
               10  IN-ORG-ROLLUP-KEY       PIC X(33).
               10  IN-ORG-ROLLUP-KEY-LEVELS  REDEFINES
                   IN-ORG-ROLLUP-KEY       OCCURS 11 TIMES.
                   15  IN-ORG-KEY-LITERAL  PIC X(02).
                   15  FILLER              PIC X(01).
               10  IN-ORG-ENTRY-MNEM       PIC X(04).
               10  IN-ORG-PRINT-SUPP-FLAG  PIC X(01).
               10  IN-ORG-SEARCH-KEY-1.
                   15  IN-ORG-DIV-1        PIC X(02).
                   15  IN-ORG-FAM-1        PIC X(02).
               10  IN-ORG-SEARCH-KEY-2.
                   15  IN-ORG-DIV-2        PIC X(02).
                   15  IN-ORG-FAM-2        PIC X(02).
               10  IN-ORG-SEARCH-KEY-3.
                   15  IN-ORG-DIV-3        PIC X(02).
                   15  IN-ORG-FAM-3        PIC X(02).
               10  IN-ORG-ENTRY-DESC       PIC X(28).

      /*************************************************************
      *    PRIME SUBTOTAL TABLE RECORD FORMAT
      **************************************************************
       01  IN-PRIME-REC.
           05  IN-PRIME-ID             PIC X(04).
           05  FILLER  REDEFINES  IN-PRIME-ID.
               10  IN-PRIME-ID-BYTE1   PIC 9(01).
               10  FILLER              PIC X(03).
           05  FILLER  REDEFINES  IN-PRIME-ID.
               10  IN-PRIME-ID-1       PIC X(01).
               10  FILLER              PIC X(03).
           05  IN-PRIME-FCST-LINE      PIC X(02).
           05  IN-PRIME-FCST-LINE-NUM  REDEFINES  IN-PRIME-FCST-LINE
                                       PIC 9(02).
           05  IN-PRIME-B-FLAG         PIC X(01).
           05  IN-PRIME-DIV-FLAG       PIC X(01).
           05  IN-PRIME-DESC           PIC X(30).
           05  IN-PRIME-CALCS          PIC X(40).
           05  IN-PRIME-CALC  REDEFINES  IN-PRIME-CALCS
                                       OCCURS 8 TIMES
                                       INDEXED BY PRIME-CALC-INDEX.
               10  IN-PRIME-OPERAND    PIC X(04).
               10  IN-PRIME-OPERATOR   PIC X(01).
           05  IN-PRIME-SUB-DEF        REDEFINES  IN-PRIME-CALCS.
               10  IN-PRIME-SUBACCT    PIC X(07).
               10  FILLER              PIC X(01).
               10  IN-PRIME-FILLER     PIC X(32).
           05  FILLER                  PIC X(02).
      /********************* WORK INDEXES ***************************
       01  WORK-INDEXES.
           05  DIST-INDEX          PIC 9(04) COMP SYNC VALUE ZERO.
           05  BOOK-INDEX          PIC 9(04) COMP SYNC VALUE ZERO.
           05  DIST-BOOK-INDEX     PIC 9(04) COMP SYNC VALUE ZERO.
           05  BOOK-DIST-INDEX     PIC 9(04) COMP SYNC VALUE ZERO.
           05  BOOK-REPORT-INDEX   PIC 9(04) COMP SYNC VALUE ZERO.
           05  ORG-FLAG-ID-INDEX   PIC 9(04) COMP SYNC VALUE ZERO.
           05  ORG-FLAG-INDEX      PIC 9(04) COMP SYNC VALUE ZERO.
           05  ORG-WORK-SUB        PIC 9(04) COMP SYNC VALUE ZERO.
           05  ORG-HDR-INDEX       PIC 9(04) COMP SYNC VALUE ZERO.
           05  REG-FLAG-ID-INDEX   PIC 9(04) COMP SYNC VALUE ZERO.
           05  REG-FLAG-INDEX      PIC 9(04) COMP SYNC VALUE ZERO.
           05  REG-WORK-SUB        PIC 9(04) COMP SYNC VALUE ZERO.
           05  REG-HDR-INDEX       PIC 9(04) COMP SYNC VALUE ZERO.
           05  PRIME-SUBTOT-INDEX  PIC 9(04) COMP SYNC VALUE ZERO.
           05  PRIME-WORK-INDEX    PIC 9(04) COMP SYNC VALUE ZERO.
           05  LINE-ID-INDEX       PIC 9(04) COMP SYNC VALUE ZERO.
           05  LINE-ENTRY-INDEX    PIC 9(04) COMP SYNC VALUE ZERO.
           05  LAST-LINE-NUMBER    PIC 9(04) COMP SYNC VALUE ZERO.
           05  NEXT-LINE-NUMBER    PIC 9(04) COMP SYNC VALUE ZERO.
           05  NORMAL-LINE-COUNT   PIC 9(04) COMP SYNC VALUE ZERO.
           05  CALC-ONLY-LINE-COUNT PIC 9(04) COMP SYNC VALUE ZERO.
           05  LINE-CALC-INDEX     PIC 9(04) COMP SYNC VALUE ZERO.
           05  LINE-CALC-COUNT     PIC 9(04) COMP SYNC VALUE ZERO.
           05  COL-ID-INDEX        PIC 9(04) COMP SYNC VALUE ZERO.
           05  COL-ENTRY-INDEX     PIC 9(04) COMP SYNC VALUE ZERO.
           05  LAST-COL-NUMBER     PIC 9(04) COMP SYNC VALUE ZERO.
           05  NEXT-COL-NUMBER     PIC 9(04) COMP SYNC VALUE ZERO.
           05  COL-CALC-INDEX      PIC 9(04) COMP SYNC VALUE ZERO.
           05  WORK-INDEX          PIC 9(04) COMP SYNC VALUE ZERO.
           05  RDF-PERIOD-INDEX    PIC 9(04) COMP SYNC VALUE ZERO.
           05  RUP-INDEX           PIC 9(04) COMP SYNC VALUE ZERO.
           05  RUP-TYPE            PIC X(01).
           05  RDF-WORK-INDEX      PIC 9(04) COMP SYNC VALUE ZERO.
           05  RUP1-WORK-LEVEL     PIC 9(04) COMP SYNC VALUE ZERO.
           05  RUP2-WORK-LEVEL     PIC 9(04) COMP SYNC VALUE ZERO.
           05  RUP1-WORK-SWITCH    PIC X(01).
           05  RUP2-WORK-SWITCH    PIC X(01).
           05  REC4-INDEX          PIC 9(04) COMP SYNC VALUE ZERO.

      /
       COPY C231ZMAX.

      /**************************************************************
      *    WORK TABLES
      ***************************************************************
       01  LOW-LEVEL-WORK-AREA.
           05  LOW-ORG-LEVEL       PIC 9(04) COMP.
           05  LOW-REG-LEVEL       PIC 9(04) COMP.

       01  ORG-KEY-WORK-AREA.
           05  ORG-KEY-WORK        PIC X(02) OCCURS 11 TIMES.

       01  ORG-HEADER-WORK-AREA.
           05  ORG-HEADER.
               10  FILLER              PIC X(02).
               10  ORG-HDR-LEVEL       PIC X(03) OCCURS 11 TIMES.
           05  ORG-HEADER-R REDEFINES ORG-HEADER.
               10  ORG-HEADER-1        PIC X(30).
               10  ORG-HEADER-2        PIC X(05).

       01  ORG-HEADER-TABLE.
           05  SAVE-ORG-HEADER     PIC X(80) OCCURS 4 TIMES.

       01  REG-KEY-WORK-AREA.
           05  REG-KEY-WORK        PIC X(02) OCCURS 8 TIMES.

       01  REG-HEADER-WORK-AREA.
           05  FILLER              PIC X(02).
           05  REG-HDR-LEVEL       PIC X(03) OCCURS 8 TIMES.

       01  REG-HEADER-TABLE.
           05  SAVE-REG-HEADER     PIC X(80) OCCURS 5 TIMES.

       01  RUP-MNEMONICS.
           05  RUP-MNEMONIC        PIC X(04) OCCURS 11 TIMES.

       01  RUP-MNEMONIC-INDEXES.
           05  RUP-MNEMONIC-INDEX  PIC 9(04) COMP OCCURS 11 TIMES.

      /**************************************************************
      *    BOOK-TO-DISTRIBUTEE TABLE
      ***************************************************************
       01  BDX-TABLE.
           05  BDX-TABLE-ENTRIES OCCURS 100 TIMES
                                 ASCENDING KEY IS BDX-TBL-BOOK-ID
                                 INDEXED BY BDX-INDEX.
               10  BDX-TABLE-ENTRY.
                   15  BDX-TBL-BOOK-ID     PIC X(04).
                   15  BDX-DISTRIBUTEES.
                       20  BDX-DIST-X      OCCURS 50 TIMES
                                           INDEXED BY BDX-DIST-INDEX.
                           25  BDX-TABLE-DIST  PIC 9(04) COMP.

       01  BOOK-EXISTENCE-FLAGS.
           05  BOOK-EXISTS-FLAG        PIC X(01) OCCURS 100 TIMES.

       01  BOOK-SAVE-AREA.
           05  SAVE-BOOK-NAME          PIC X(75) VALUE SPACES.

       01  BOOK-NAME-TABLE.
           05  BOOK-NAME               PIC X(75) OCCURS 100 TIMES.

       01  DIST-NAME-TABLE.
           05  DIST-NAME               PIC X(76) OCCURS 50 TIMES.

       01  DIST-BOOK-TABLE.
           05  DBT-ENTRY               OCCURS 50 TIMES.
               10  DBT-DIST-INDEX              PIC 9(04) COMP.
               10  DBT-DIST-NAME               PIC X(76).
               10  DBT-DIST-BOOKS.
                   15  DBT-DIST-BOOK   OCCURS 45 TIMES.
                       20  DBT-BOOK-ID         PIC X(04).
                       20  DBT-BOOK-COPIES     PIC 9(02).
                       20  DBT-BOOK-BURST-FLAG PIC X(01).
               10  DBT-BOOK-ENTRY-INDEX        PIC 9(04) COMP.
      /**************************************************************
      *    COLUMN WORK TABLE  -
      *        USED IN THE EDIT OF THE REPORT DEFINITION TABLE
      ***************************************************************
       01  COL-WORK-TABLE.
           05  COL-WORK-TABLE-ENTRY    OCCURS 150 TIMES.
               10  COL-WORK-TABLE-FLAG OCCURS 56 TIMES   PIC X(01).
      *      VALUES : ' ' - NO ENTRY ON COL TABLE
      *               'D' - 'DEFAULT' WAS CODED FOR THE COLUMN
      *               'X' - SOMETHING WAS CODED FOR THE COLUMN

      ***************************************************************
      *    REPORT TABLE - 150 OCCURRENCES OF THE INTERNAL FORMAT
      *                   OF THE REPORT DEFINITION TABLE, DESCRIBED
      *                   IN RDF-RECORD.
      *            NOTE:  IF THE NUMBER OF OCCURRENCES IN THIS TABLE
      *                   INCREASES, INCREASE THE NUMBER OF OCCURANCES
      *                   IN COL-WORK-TABLE ABOVE AND IN THE
      *                   LINE-COL-WORK-TABLE FOUND LATER IN WORKING
      *                   STORAGE.  AND CHECK MAX-RDT AND
      *                   MAX-RPT-WORK-ENTRIES.  CHANGE ERROR MESSAGE
      *                   IN PARAGRAPH 1170-PROCESS-REPORT-SORT-RECS.
      ***************************************************************
       01  REPORT-TABLE.
           05  REPORT-TABLE-ENTRIES
                       OCCURS 151 TIMES
                       ASCENDING KEY IS RDT-REPORT-ID
                       INDEXED BY REPORT-INDEX.
               10  REPORT-TABLE-ENTRY.
                   15  RDT-REPORT-ID       PIC X(04).
                   15  FILLER              PIC X(04).
                   15  RDT-ORG-ID          PIC X(02).
                   15  RDT-ORG-ID-INDEX    PIC 9(04) COMP.
                   15  RDT-ORG-TOT-ENTRY   PIC 9(04) COMP.
                   15  RDT-REG-ID          PIC X(02).
                   15  RDT-REG-ID-INDEX    PIC 9(04) COMP.
                   15  RDT-LINE-ID         PIC X(02).
                   15  FILLER              PIC X(02).
                   15  RDT-COL-ID          PIC X(02).
                   15  FILLER              PIC X(748).

      /
       COPY C231WRDF.
      *  NOTE: THESE FIELDS BELOW ARE USED ONLY IN THIS PROGRAM...
      *  WHEN THE REPORT TABLE IS WRITTEN OUT THIS PORTION IS
      *  TRUNCATED.......
           05  RDF-RUP1-MNEMONICS.
               10  RDF-RUP1-MNEMONIC   OCCURS 11 TIMES
                                       PIC X(04).
           05  RDF-RUP1-INDEXES.
               10  RDF-RUP1-INDEX      OCCURS 11 TIMES
                                       PIC 9(04)  COMP.
           05  RDF-RUP2-MNEMONICS.
               10  RDF-RUP2-MNEMONIC   OCCURS 11 TIMES
                                       PIC X(04).
           05  RDF-RUP2-INDEXES.
              10  RDF-RUP2-INDEX       OCCURS 11 TIMES
                                       PIC 9(04)  COMP.
           05  RDF-PERIOD-MNEMONICS.
               10  RDF-PERIOD-MNEMONIC     OCCURS 56 TIMES
                                       PIC X(03).
           05  RDF-TOC-DESCRIPTION     PIC X(52).


      /**************************************************************
      *    ORG TABLE - MAX OF 4 ORG TABLES ALLOWED, WITH A MAX OF
      *               5000 ENTRIES IN EACH.
      ***************************************************************
       01  ORG-TABLE-1.
           05  ORG-TABLE-ENTRIES-1  OCCURS 4 TIMES.
               10  ORG-TABLE-ENTRY-1     OCCURS 5000 TIMES.
                   15  ORG-TBL-ID              PIC X(02).
                   15  ORG-TBL-ROLLUP-KEY      PIC X(22).
                   15  ORG-TBL-KEY-LEVEL       PIC 9(04) COMP.
                   15  ORG-TBL-KEY-HI-LEVEL    PIC 9(04) COMP.
                   15  ORG-TBL-NEXT-TOT        PIC 9(04) COMP.
       01  ORG-TABLE-2.
           05  ORG-TABLE-ENTRIES-2  OCCURS 4 TIMES.
               10  ORG-TABLE-ENTRY-2     OCCURS 5000 TIMES.
                   15  ORG-TBL-USAGE-FLAG      PIC X(01).
                   15  ORG-TBL-SEARCH-KEY-1    PIC X(04).
                   15  ORG-TBL-SEARCH-KEY-2    PIC X(04).
                   15  ORG-TBL-SEARCH-KEY-3    PIC X(04).
                   15  ORG-TBL-ENTRY-MNEM      PIC X(04).
       01  ORG-TABLE-3.
           05  ORG-TABLE-ENTRIES-3  OCCURS 4 TIMES.
               10  ORG-TABLE-ENTRY-3     OCCURS 5000 TIMES.
                   15  ORG-TBL-DESC            PIC X(30).

       01  ORG-TOT-ENTRY-TABLE.
           05  ORG-TOT-ENTRY   PIC 9(04) COMP  OCCURS 4 TIMES.

       01  ORG-FLAG-TABLE.
           05  ORG-TABLE-FLAG-AREA  OCCURS 4 TIMES.
               10  ORG-FLAG-ENTRY   OCCURS 5000 TIMES.
                   15  ORG-TBL-PRINT-SUPP-FLAG PIC X(01).
                   15  ORG-TBL-MNEM-FLAG       PIC X(01).
                   15  ORG-TBL-LEVEL-FLAG      PIC X(01).
                   15  ORG-TBL-KEY-FLAG        PIC X(01).
                   15  ORG-TBL-ROLLUP-FLAG     PIC X(01).

       01  ORG-MNEMONIC-TABLE.
           05  ORG-MNEMONIC-TABLE-ENTRIES
                          OCCURS 4000 TIMES
                          ASCENDING KEY IS ORG-MNEMONIC-KEY
                          INDEXED BY ORG-M-INDEX.
               10  ORG-MNEMONIC-KEY.
                   15  ORG-MNEMONIC-KEY-ID     PIC 9(04) COMP.
                   15  ORG-MNEMONIC-KEY-VALUE  PIC X(04).
               10  ORG-MNEMONIC-ENTRY-INDEX    PIC 9(04) COMP.


      /**************************************************************
      *    REG TABLE - MAX OF 10 REG TABLES ALLOWED, WITH A MAX OF
      *                100 ENTRIES IN EACH.
      ***************************************************************
       01  REG-TABLE.
           05  REG-TABLE-ENTRIES  OCCURS 10 TIMES
                                  INDEXED BY REG-ID-INDEX.
               10  REG-TABLE-ENTRY     OCCURS 200 TIMES
                                       INDEXED BY REG-ENTRY-INDEX
                                                  REG-ROLLUP-INDEX.
                   15  REG-TBL-ID              PIC X(02).
                   15  REG-TBL-ROLLUP-KEY      PIC X(16).
                   15  REG-TBL-KEY-LEVEL       PIC 9(04) COMP.
                   15  REG-TBL-KEY-HI-LEVEL    PIC 9(04) COMP.
                   15  REG-TBL-NEXT-TOT        PIC 9(04) COMP.
                   15  REG-TBL-USAGE-FLAG      PIC X(01).
                   15  REG-TBL-SEARCH-KEY      PIC X(06).
                   15  REG-TBL-DESC            PIC X(30).
                   15  REG-TBL-ENTRY-MNEM      PIC X(04).

       01  REG-TOT-ENTRY-TABLE.
           05  REG-TOT-ENTRY   PIC 9(04) COMP  OCCURS 5 TIMES.

       01  REG-FLAG-TABLE.
           05  REG-TABLE-FLAG-AREA  OCCURS 10 TIMES.
               10  REG-FLAG-ENTRY   OCCURS  100 TIMES.
                   15  REG-TBL-MNEM-FLAG       PIC X(01).
                   15  REG-TBL-LEVEL-FLAG      PIC X(01).
                   15  REG-TBL-SEARCH-KEY-FLAG PIC X(01).
                   15  REG-TBL-KEY-FLAG        PIC X(01).
                   15  REG-TBL-ROLLUP-FLAG     PIC X(01).

       01  REG-MNEMONIC-TABLE.
           05  REG-MNEMONIC-TABLE-ENTRIES
                          OCCURS 1000 TIMES
                          ASCENDING KEY IS REG-MNEMONIC-KEY
                          INDEXED BY REG-M-INDEX.
               10  REG-MNEMONIC-KEY.
                   15  REG-MNEMONIC-KEY-ID     PIC 9(04) COMP.
                   15  REG-MNEMONIC-KEY-VALUE  PIC X(04).
               10  REG-MNEMONIC-ENTRY-INDEX    PIC 9(04) COMP.

       01  REG-HDR-FLAG-TABLE.
           05  REG-HDR-FLAG-AREA  OCCURS 5 TIMES.
               10  REG-HDR-LOC-FLAG            PIC X(01).
               10  REG-HDR-DIV-FLAG            PIC X(01).
               10  REG-HDR-LOC-DIV-FLAG        PIC X(01).
               10  REG-HDR-DIV-FAM-FLAG        PIC X(01).

      /**************************************************************
      *    PRIME TABLE - 1000 ENTRIES MAXIMUM, HOLDS PXT RECORD
      *                  FORMAT, ALONG WITH WORK INDEX FOR SUBTOTS
      ***************************************************************
       01  PRIME-TABLE.
           05  PRIME-TABLE-ENTRIES  OCCURS 5000 TIMES
                                    INDEXED BY PRIME-CHK-INDEX
                                               PRIME-INDEX.
               10  PRIME-TABLE-ENTRY.
                   15  PRIME-TBL-ID            PIC X(07).
                   15  PRIME-TBL-B-FLAG        PIC X(01).
                   15  PRIME-TBL-DIV-FLAG      PIC X(01).
                   15  PRIME-TBL-SUBTOT-INDEX  PIC 9(04) COMP.
                   15  PRIME-TBL-FCST-LINE     PIC X(02).
                   15  PRIME-TBL-USAGE-FLAG    PIC X(01).
                   15  PRIME-TBL-SUBTOTS       OCCURS 14 TIMES
                                      INDEXED BY PRIME-SUB-INDEX.
                       20  PRIME-TBL-SUB       PIC 9(04) COMP.
                       20  PRIME-TBL-OPR       PIC X(01).
                   15  PRIME-TBL-DESC          PIC X(30).
                   15  PRIME-TBL-NEXT-SUB      PIC 9(04) COMP.

       01  PRIME-ID-TABLE.
           05  PRIME-ID-TABLE-ENTRIES OCCURS 5000 TIMES
                                      ASCENDING KEY IS PRIME-SRT-ID
                                      INDEXED BY PRIME-SRT-INDEX.
               10  PRIME-SRT-ID              PIC X(04).
               10  PRIME-SRT-ENTRY-INDEX     PIC 9(04) COMP.

      *   THE TABLE BELOW CONTAINS A CROSS-REFERENCE OF SUBTOT
      *   INDEX TO PRIME INDEX, IE., THE 5TH ENTRY (SUBTOT #5)
      *   HAS THE INDEX INTO THE PRIME TABLE FOR THAT PRIME SUBTOTAL.

       01  PRIME-SUBTOT-TABLE.
           05  PRIME-SUBTOT-TBL-INDEX   OCCURS 500 TIMES
                                        PIC 9(04) COMP.

       01  PRIME-SUBACCT-TABLE.
           05  PRIME-SUBACCT-ENTRIES OCCURS 5000 TIMES
                      INDEXED BY PRIME-SUBACCT-INDEX.
               10  PRIME-SUBACCT-ID          PIC X(07).
               10  PRIME-SUBACCT-PRIME-INDEX PIC 9(04) COMP.
      /*************************************************************
      *****  EXPANDED BOOK DEFINITION WORK AREAS ......
      **************************************************************
       01  EBD-WORK-FIELDS.
           05  PRINT-SUPP-FLAG         PIC X(01) VALUE SPACE.
           05  BOOK-TITLE-FLAG         PIC X(01) VALUE SPACE.
           05  BOOK-RPT-FOUND-SWITCH   PIC X(01) VALUE 'N'.
           05  GEN-TOC-FLAG            PIC X(01) VALUE 'N'.
           05  READ-BOOK-FLAG          PIC X(01) VALUE 'Y'.
           05  BOOK-PAGE-NUMBER        PIC 9(04) COMP SYNC.
           05  BOOK-ORG-ID             PIC X(02) VALUE SPACES.
           05  BOOK-ORG-ID-INDEX       PIC 9(04) COMP SYNC.
           05  BOOK-REG-ID             PIC X(02) VALUE SPACES.
           05  BOOK-REG-ID-INDEX       PIC 9(04) COMP SYNC.
           05  BOOK-RUP1-TYPE          PIC X(01) VALUE SPACE.
           05  BOOK-RUP2-TYPE          PIC X(01) VALUE SPACE.
           05  LITERAL-MATCH-FLAG      PIC X(01) VALUE SPACE.
           05  REC5-INDEX              PIC 9(08) COMP SYNC.
           05  REC6-COUNT              PIC 9(08) COMP SYNC VALUE 0.
           05  REC6-TBL-INDEX          PIC 9(08) COMP SYNC.
           05  REC6-ENTRY-INDEX        PIC 9(08) COMP SYNC.
           05  REC6-WORK-INDEX         PIC 9(08) COMP SYNC.
           05  REC6-LITERAL            PIC X(02).
           05  REC6-LITERAL-LEVEL      PIC 9(04) COMP SYNC.
           05  SAVE-REC6-LEVEL         PIC 9(04) COMP SYNC.
           05  WORK-LEVEL              PIC 9(04) COMP SYNC.
           05  RUP1-LEVEL              PIC 9(04) COMP SYNC.
           05  RUP2-LEVEL              PIC 9(04) COMP SYNC.
           05  RUP1-INDEX              PIC 9(08) COMP SYNC.
           05  RUP2-INDEX              PIC 9(08) COMP SYNC.
           05  RUP1-OFFSET             PIC 9(08) COMP SYNC.
           05  RUP1-CODE               PIC X(02).
           05  RUP2-OFFSET             PIC 9(08) COMP SYNC.
           05  RUP2-CODE               PIC X(02).
           05  ORG-LEVEL-INDEX         PIC 9(08) COMP SYNC.
           05  REG-LEVEL-INDEX         PIC 9(08) COMP SYNC.
           05  LIT-INDEX               PIC 9(04) COMP SYNC.
           05  MATCH-INDEX             PIC 9(04) COMP SYNC.
      /
       01  BOOK-RPT-RUP-MATCH-FLAGS.
           05  AT-LEAST-ONE-BOOK-RUP-ON-RPT     PIC X(01).
           05  EVERY-BOOK-RUP-ON-RPT            PIC X(01).
           05  BOOK-RUP-ON-RPT                  PIC X(01).

       01  TOC-WORK-AREA.
           05  TOC-WORK-AREA-1         PIC X(52).
           05  FILLER                  PIC X(03) VALUE ' - '.
           05  TOC-ROLLUP-AREA.
               10  TOC-ROLLUP-KEY      PIC X(23).
               10  TOC-WORK-AREA-2     PIC X(30).

       01  TOC-RUP1-RUP2-AREA.
           05  TOC-RUP1-AREA       PIC X(25).
           05  FILLER              PIC X(03) VALUE ' - '.
           05  TOC-RUP2-AREA       PIC X(25).

       01  BDAM-WORK-AREAS.
           05  REL-REC-OCF             PIC 9(08) COMP SYNC.
           05  REL-REC-RCF             PIC 9(08) COMP SYNC.
           05  REL-REC-PCF             PIC 9(08) COMP SYNC.
           05  REL-REC-LCF             PIC 9(08) COMP SYNC.
           05  REL-REC-LDF             PIC 9(08) COMP SYNC.
           05  REL-REC-CBF             PIC 9(08) COMP SYNC.

       01  WORK-RPT-TABLE.
           05  WORK-RPT-ENTRIES        OCCURS 19 TIMES.
               10  WORK-RPT-INDEX          PIC 9(04) COMP.
               10  WORK-RPT-RUP1-LEVELS    PIC X(44).
               10  WORK-RPT-RUP2-LEVELS    PIC X(44).
      /
       01  BOOK-RUP-LEVEL-TABLES.
           05  BOOK-RUP1-LEVELS.
               10  BOOK-RUP1-LEVEL         PIC 9(04) COMP
                                           OCCURS 11 TIMES.
           05  BOOK-RUP2-LEVELS.
               10  BOOK-RUP2-LEVEL         PIC 9(04) COMP
                                           OCCURS 11 TIMES.

       01  REC5-RUP-LEVEL-TABLES.
           05  REC5-RUP1-LEVELS.
               10  REC5-RUP1-LEVEL         PIC 9(04) COMP
                                           OCCURS 11 TIMES.
           05  REC5-RUP2-LEVELS.
               10  REC5-RUP2-LEVEL         PIC 9(04) COMP
                                           OCCURS 11 TIMES.

       01  REC5-RUP-CODE-TABLES.
           05  REC5-RUP1-CODES.
               10  REC5-RUP1-LITERAL-FLAG  PIC X(01).
               10  REC5-RUP1-CODE          PIC X(02)
                                           OCCURS 11 TIMES.
               10  REC5-RUP1-SUPP          PIC X(01)
                                           OCCURS 11 TIMES.
           05  REC5-RUP2-CODES.
               10  REC5-RUP2-LITERAL-FLAG  PIC X(01).
               10  REC5-RUP2-CODE          PIC X(02)
                                           OCCURS 11 TIMES.
               10  REC5-RUP2-SUPP          PIC X(01)
                                           OCCURS 11 TIMES.

       01  REC5-RUP-TABLES.
           05  REC5-RUP1-TABLE.
               10  REC5-RUP1-ENTRY-INDEX   PIC 9(04) COMP
                                           OCCURS 1000 TIMES.
               10  REC5-RUP1-ENTRY-LEVEL   PIC 9(04) COMP
                                           OCCURS 1000 TIMES.
           05  REC5-RUP2-TABLE.
               10  REC5-RUP2-ENTRY-INDEX   PIC 9(04) COMP
                                           OCCURS 1000 TIMES.
               10  REC5-RUP2-ENTRY-LEVEL   PIC 9(04) COMP
                                           OCCURS 1000 TIMES.

       01  RUP2-ENTRY-FLAGS.
           05  RUP2-ENTRY-FLAG             PIC X(01)
                                           OCCURS 18 TIMES.

       01  REC6-TABLE.
           05  REC6-RUP1-TABLE     OCCURS 10 TIMES.
               10  REC6-RUP1-ENTRY-INDEX   PIC 9(04) COMP
                                           OCCURS 1000 TIMES.
               10  REC6-RUP1-ENTRY-LEVEL   PIC 9(04) COMP
                                           OCCURS 1000 TIMES.

       01  REC6-FULL-RUP1-TABLE.
           05  REC6-WORK-TABLE.
               10  REC6-WORK-ENTRY         PIC 9(04) COMP
                                           OCCURS 1000 TIMES.
               10  REC6-WORK-LEVEL         PIC 9(04) COMP
                                           OCCURS 1000 TIMES.
      /
       01  SAVE-AREAS.
           05  SAVE-DIST-ID             PIC X(04) VALUE SPACES.
           05  SAVE-BOOK-ID             PIC X(04) VALUE SPACES.
           05  SAVE-BOOK-TITLE-MEMO     PIC X(75) VALUE SPACES.
           05  SAVE-REPORT-ID           PIC X(04) VALUE SPACES.
           05  LAST-BOOK-REC-TYPE       PIC X(01) VALUE SPACES.

      *   THE FOLLOWING TWO AREAS ARE USED FOR APPLYING LITERAL
      *   CODING TO SUBSEQUENT RECORD TYPE '5'S.......

       01  SAVE-BOOK-REC5.
           05  FILLER                   PIC X(07).
           05  SAVED-REC5-RUP1-CODE-AREA    OCCURS 11 TIMES.
               10  SAVED-REC5-RUP1-CODE PIC X(02).
               10  SAVED-REC5-RUP1-SUPP PIC X(01).
           05  SAVED-REC5-RUP2-CODE-AREA    OCCURS 11 TIMES.
               10  SAVED-REC5-RUP2-CODE PIC X(02).
               10  SAVED-REC5-RUP2-SUPP PIC X(01).
           05  FILLER                   PIC X(07).

       01  RUP-LIT-MOVED-FLAGS.
           05  RUP1-LIT-MOVED-FLAG      PIC X(01) OCCURS 11 TIMES.
           05  RUP2-LIT-MOVED-FLAG      PIC X(01) OCCURS 11 TIMES.
           05  MOVE-RUP1-LITERALS-FLAG  PIC X(01) VALUE SPACE.
           05  MOVE-RUP2-LITERALS-FLAG  PIC X(01) VALUE SPACE.
      /
       01  CALC-WORK-RECORD.
           05  CALC-WORK-KEY.
               10  CALC-BREAK-KEY.
                   15  CALC-REC-TYPE        PIC X(01).
                   15  CALC-REC-REL-REC     PIC 9(04) COMP.
               10  CALC-REC-REPORT-INDEX    PIC 9(04) COMP.
           05  CALC-REC-LCP-FLAG            PIC X(01).
           05  CALC-REC-LINE-COL-NO         PIC 9(04) COMP.
           05  CALC-REC-REL-CALC            PIC 9(04) COMP.
           05  CALC-REC-OPERATOR            PIC X(01).

       01  CALC-WORK-RECORD-2.
           05  CALC-WORK-KEY-2.
               10  CALC-REC2-TYPE           PIC X(01).
               10  CALC-REC2-REL-REC        PIC 9(04) COMP.
               10  CALC-REC2-REPORT-INDEX   PIC 9(04) COMP.
           05  CALC-REC2-LCP-FLAG           PIC X(01).
           05  CALC-REC2-LINE-COL-NO        PIC 9(04) COMP.
           05  CALC-REC2-REL-CALC           PIC 9(04) COMP.
           05  CALC-REC2-OPERATOR           PIC X(01).

       01  SAVE-CALC-WORK-KEY.
           05  SAVE-CALC-BREAK-KEY.
               10  SAVE-CALC-REC-TYPE       PIC X(01).
               10  SAVE-CALC-REC-REL-REC    PIC 9(04) COMP.
           05  SAVE-CALC-REC-REPORT-INDEX   PIC 9(04) COMP.

       01  CALC-WORK-INDEXES.
           10  ORG-CALC-SUB               PIC 9(04) COMP SYNC.
           10  REG-CALC-SUB               PIC 9(04) COMP SYNC.
           10  PRI-CALC-SUB               PIC 9(04) COMP SYNC.

      /
       01  LINE-COL-WORK-TABLE.
           05  LINE-COL-ORG-REG-RPT     OCCURS 150 TIMES.
               10  WORK-ORG             PIC 9(04) COMP.
               10  WORK-REG             PIC 9(04) COMP.
               10  WORK-RPT             PIC 9(04) COMP.

       01  OPERATOR-OPERAND-WORK-AREAS.
           05  OPND-WORK.
               10  OPND-WORK-BYTE-1     PIC X(01).
               10  OPND-WORK-BYTES-2-4  PIC 9(03).
           05  OPTR-WORK                PIC X(01).
           05  COL-OPTR-WORK            PIC X(01).
           05  COL-SEARCH-TYPE          PIC X(01).

       01  WORK-KEY.
           05  WORK-KEY-ID-INDEX        PIC 9(04) COMP.
           05  WORK-KEY-MNEM            PIC X(04).

       01  LINE-ID-WORK.
           05  FILLER                   PIC X(01) VALUE 'L'.
           05  LINE-ID-WORK-NUM         PIC X(02).

       01  LINE-ID-TABLE-AREA.
           05  LINE-ID-TABLE         OCCURS 40 TIMES
                                     INDEXED BY LINE-INDEX.
               10  LINE-TBL-ID          PIC X(03).
               10  LINE-TBL-TYPE        PIC X(01).

       01  COL-ID-WORK.
           05  FILLER                   PIC X(01) VALUE 'C'.
           05  COL-ID-WORK-NUM          PIC X(02).

       01  COL-ID-TABLE-AREA.
           05  COL-ID-TABLE          OCCURS 50 TIMES
                                     INDEXED BY COL-INDEX.
               10  COL-TBL-ID           PIC X(03).
               10  COL-TBL-TYPE         PIC X(01).

       01  ORC-WORK-AREAS.
           05  FCST-PLAN-FLAG           PIC X(01).
           05  SAVE-ORC-KEY.
               10  SAVE-ORC-REC-TYPE    PIC X(01).
               10  SAVE-ORC-ORG-REG.
                   15  SAVE-ORC-ORG     PIC 9(04) COMP.
                   15  SAVE-ORC-REG     PIC 9(04) COMP.
      /***********************************************************
      *       INTERNAL RECORD DESCRIPTIONS
      ************************************************************
       COPY C231WCTF.
       COPY C231WBDX.
      /
       COPY C231WPXT.
       COPY C231WORC.
      /
       COPY C231WOTF.
       COPY C231WRTF.
      /
       COPY C231WLCF.
       COPY C231WLDF.
       COPY C231WCBF.
       COPY C231WEXB.
      /
       COPY C231WTCM.
       COPY C231WDBF.
       COPY C231WPCF.
      /***********************************************************
      *       EDIT REPORT PRINT AREAS, HEADINGS
      ************************************************************

       01  WORK-TIME.
           05  HRS                 PIC 9(02).
           05  MIN                 PIC 9(02).
           05  SEC                 PIC 9(02).

       01  HEADING-1.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  FILLER              PIC X(03) VALUE 'R23'.
           05  H-SYSID             PIC X(01).
           05  FILLER              PIC X(04) VALUE '-TE1'.
           05  FILLER              PIC X(38) VALUE SPACES.
           05  FILLER              PIC X(75) VALUE
           'NATIONAL SEMICONDUCTOR CORPORATION'.
           05  FILLER              PIC X(05) VALUE 'PAGE '.
           05  H-PAGE              PIC Z(5).

       01  HEADING-2.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  FILLER              PIC X(04)   VALUE 'PER '.
           05  H-PERIOD            PIC Z(02).
           05  FILLER              PIC X(04)   VALUE ' FY '.
           05  H-FISCAL-YR         PIC 9(02).
           05  FILLER              PIC X(08)   VALUE ' ENDING '.
           05  H-END-MONTH         PIC X(03).
           05  FILLER              PIC X(01)   VALUE SPACE.
           05  H-END-DAY           PIC Z(02).
           05  FILLER              PIC X(04)   VALUE ', 19'.
           05  H-END-YR            PIC 9(02).
           05  FILLER              PIC X(11) VALUE SPACES.
           05  FILLER              PIC X(65) VALUE
           'FINANCIAL REPORTING SYSTEM TABLE EDIT'.
           05  FILLER              PIC X(06) VALUE 'AS OF '.
           05  H-DATE              PIC X(10).
           05  H-TIME.
               10  H-HRS           PIC Z(02).
               10  FILLER          PIC X(01) VALUE ':'.
               10  H-MIN           PIC 9(02).
               10  FILLER          PIC X(01) VALUE SPACES.
               10  H-AM-PM         PIC X(02) VALUE SPACES.

       01  HEADING-3.
           05  FILLER              PIC X(45) VALUE SPACES.
           05  H-TITLE             PIC X(50).

       01  EDIT-REPORT-TITLES.
           05  PRIME-TITLE         PIC X(50) VALUE
           '  PRIME CALCULATION TABLE ENTRIES       '.
           05  ORG-TITLE           PIC X(50) VALUE
           '    ORGANIZATION TABLE REPORT           '.
           05  REG-TITLE           PIC X(50) VALUE
           'REGION/LOCATION/LEGAL ENTITY TABLE ENTRIES'.
           05  BOOK-TITLE          PIC X(50) VALUE
           '   BOOK DEFINITION TABLE ENTRIES        '.
           05  DIST-TITLE          PIC X(50) VALUE
           ' BOOK DISTRIBUTION CROSS-REFERENCE      '.
           05  REPORT-TITLE        PIC X(50) VALUE
           '  REPORT DEFINITION TABLE ENTRIES       '.
           05  LINE-TITLE          PIC X(50) VALUE
           '  LINE CALCULATION TABLE ENTRIES        '.
           05  COL-TITLE           PIC X(50) VALUE
           ' COLUMN CALCULATION TABLE ENTRIES       '.

       01  DASH-LINE.
           05  FILLER              PIC X(132) VALUE ALL '-'.

       01  DASH-LINE-2.
           05  FILLER              PIC X(30) VALUE SPACES.
           05  FILLER              PIC X(60) VALUE ALL '-'.
      /
       01  ORG-HEADING-1.
           05  FILLER              PIC X(25) VALUE
           ' ORG TABLE REFERENCE   : '.
           05  H-ORG-ID            PIC X(03).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  H-ORG-FAM-AREA.
               10  H-ORG-FAM-MSG       PIC X(20) VALUE SPACES.
               10  H-ORG-DEFAULT-FAM   PIC X(02).

       01  ORG-HEADING-2.
           05  FILLER              PIC X(25) VALUE
           ' ORG TABLE DESCRIPTION : '.
           05  H-ORG-DESC          PIC X(30) VALUE SPACES.

       01  ORG-HEADING-3.
           05  FILLER              PIC X(16) VALUE
           ' -------------'.
           05  FILLER              PIC X(23) VALUE
           '  ORGANIZATION LEVELS  '.
           05  FILLER              PIC X(08) VALUE
           '    ----'.

       01  ORG-HEADING-4.
           05  FILLER              PIC X(51) VALUE '  ENT'.
           05  FILLER              PIC X(69) VALUE
           'PRINT    G/L      G/L      G/L'.
           05  FILLER              PIC X(04) VALUE 'DATA'.

       01  ORG-HEADING-5.
           05  FILLER              PIC X(06) VALUE '  NO.'.
           05  H-ORG-LEVELS.
               10  H-ORG-LEVEL     PIC X(04) OCCURS 11 TIMES.
           05  FILLER              PIC X(08) VALUE '  SUPP  '.
           05  FILLER              PIC X(62) VALUE
           'DIV-FAM  DIV-FAM  DIV-FAM      DESCRIPTION'.
           05  FILLER              PIC X(10) VALUE
           'IDENTIFIER'.

       01  ORG-DETAIL-LINE.
           05  FILLER              PIC X(02) VALUE SPACES.
           05  D-ORG-ENTRY-INDEX   PIC Z(03).
           05  FILLER              PIC X(02) VALUE SPACES.
           05  D-ORG-ROLLUP-LEVEL  PIC X(04)
                                   OCCURS 11 TIMES.
           05  FILLER              PIC X(04) VALUE SPACES.
           05  D-ORG-SUPP-FLAG     PIC X(01) VALUE SPACES.
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-ORG-SEARCH-KEY-1  PIC XXBBXXBBB.
           05  D-ORG-SEARCH-KEY-2  PIC XXBBXXBBB.
           05  D-ORG-SEARCH-KEY-3  PIC XXBBXXBBBBBB.
           05  D-ORG-DESC          PIC X(28).
           05  FILLER              PIC X(03).
           05  D-ORG-MNEM          PIC X(04).

       01  ORG-ERROR-LINE  REDEFINES  ORG-DETAIL-LINE.
           05  FILLER              PIC X(80).
           05  D-ORG-ERROR-MSG     PIC X(50).
      /
       01  REG-HEADING-1.
           05  FILLER              PIC X(25) VALUE
           ' REG TABLE REFERENCE   : '.
           05  H-REG-ID            PIC X(03).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  H-REG-ERROR-MSG     PIC X(50) VALUE SPACES.

       01  REG-HEADING-2.
           05  FILLER              PIC X(25) VALUE
           ' REG TABLE DESCRIPTION : '.
           05  H-REG-DESC          PIC X(30) VALUE SPACES.

       01  REG-HEADING-3.
           05  FILLER              PIC X(18) VALUE
           '  ENT ------------'.
           05  FILLER              PIC X(21) VALUE
           '  LOCATIONAL LEVELS  '.
           05  FILLER              PIC X(31) VALUE
           '------------    ------G/L------'.
           05  FILLER              PIC X(34) VALUE SPACES.
           05  FILLER              PIC X(04) VALUE 'DATA'.

       01  REG-HEADING-4.
           05  FILLER              PIC X(07) VALUE '  NO.'.
           05  H-REG-LEVELS.
               10  H-REG-LEVEL     PIC X(06)
                                   OCCURS 8 TIMES.
           05  FILLER              PIC X(49) VALUE
           ' LOC - DIV - FAM  DESCRIPTION'.
           05  FILLER              PIC X(10) VALUE
           'IDENTIFIER'.

       01  REG-DETAIL-LINE.
           05  FILLER              PIC X(02) VALUE SPACES.
           05  D-REG-ENTRY-INDEX   PIC Z(03).
           05  FILLER              PIC X(02) VALUE SPACES.
           05  D-REG-ROLLUP-LEVEL  PIC X(06)
                                   OCCURS 8 TIMES.
           05  FILLER              PIC X(02).
           05  D-REG-SEARCH-KEY    PIC XXBBBBXXBBBBXXBB.
           05  D-REG-DESC          PIC X(28).
           05  FILLER              PIC X(03).
           05  D-REG-MNEM          PIC X(04).

       01  REG-ERROR-LINE  REDEFINES  REG-DETAIL-LINE.
           05  FILLER              PIC X(80).
           05  D-REG-ERROR-MSG     PIC X(50).
      /
       01  PRIME-HEADING-1.
           05  FILLER              PIC X(33) VALUE
           '                 B   D   FCST'.
           05  FILLER              PIC X(32) VALUE SPACES.
           05  FILLER              PIC X(22) VALUE
           '-------------------'.
           05  FILLER              PIC X(23) VALUE
           'ARITHMETIC CALCULATIONS'.
           05  FILLER              PIC X(22) VALUE
           '----------------------'.

       01  PRIME-HEADING-2.
           05  FILLER              PIC X(76) VALUE
           '   PRIME  INDEX  S   D   LINE  DESCRIPTION'.
           05  FILLER              PIC X(50) VALUE
           '       OPERATIONS : + (ADD)   - (MINUS) '.

       01  PRIME-DETAIL-LINE.
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-ID          PIC X(04).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-INDEX       PIC Z(04).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-B-FLAG      PIC X(01).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-DIV-FLAG    PIC X(01).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-FCST-LINE   PIC X(02).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-DESC        PIC X(28).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-PRIME-CALC-AREA   PIC X(56).
           05  D-PRIME-CALCS       REDEFINES D-PRIME-CALC-AREA
                                   OCCURS 8 TIMES.
               10  D-PRIME-OPERAND     PIC X(05).
               10  D-PRIME-OPERATOR    PIC X(02).

       01  PRIME-ERROR-LINE  REDEFINES  PRIME-DETAIL-LINE.
           05  FILLER              PIC X(27).
           05  D-PRIME-ERROR-MSG   PIC X(50).
           05  FILLER              PIC X(44).
      /
       01  LINE-HEADING-1.
           05  FILLER              PIC X(17) VALUE
           ' LINE TABLE ID : '.
           05  H-LINE-ID           PIC X(03).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  H-LINE-ERROR-MSG    PIC X(35) VALUE SPACES.

       01  LINE-HEADING-2.
           05  FILLER              PIC X(17) VALUE
           '    TABLE TYPE : '.
           05  H-LINE-TYPE         PIC X(01).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  H-L-TYPE-ERROR-MSG  PIC X(37) VALUE SPACES.
           05  FILLER              PIC X(03) VALUE SPACES.
           05  FILLER              PIC X(22) VALUE
           '-------------------'.
           05  FILLER              PIC X(23) VALUE
           'ARITHMETIC CALCULATIONS'.
           05  FILLER              PIC X(22) VALUE
           '----------------------'.

       01  LINE-HEADING-3.
           05  FILLER              PIC X(73) VALUE
           '   LINE DESCRIPTION                       EDIT'.
           05  FILLER              PIC X(50) VALUE
           '       OPERATIONS : + (ADD)   - (MINUS) '.

       01  LINE-DETAIL-LINE.
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-LINE-NO           PIC Z(03).
           05  D-LINE-NO-X  REDEFINES  D-LINE-NO    PIC X(03).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-LINE-DESCRIPTION  PIC X(33).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  D-LINE-EDIT-TYPE    PIC X(01).
           05  FILLER              PIC X(19) VALUE SPACES.
           05  D-LINE-CALCS        OCCURS 8 TIMES.
               10  D-LINE-OPERAND      PIC X(05).
               10  D-LINE-OPERATOR     PIC X(02).

       01  LINE-ERROR-LINE  REDEFINES  LINE-DETAIL-LINE.
           05  FILLER              PIC X(20).
           05  D-LINE-ERROR-MSG    PIC X(50).
           05  FILLER              PIC X(49).
      /
       01  COL-HEADING-1.
           05  FILLER              PIC X(19) VALUE
           ' COLUMN TABLE ID : '.
           05  H-COL-ID            PIC X(03).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  H-COL-ERROR-MSG     PIC X(40) VALUE SPACES.

       01  COL-HEADING-2.
           05  FILLER              PIC X(19) VALUE
           '      TABLE TYPE : '.
           05  H-COL-TYPE          PIC X(01).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  H-C-TYPE-ERROR-MSG  PIC X(38) VALUE SPACES.
           05  FILLER              PIC X(22) VALUE
           '-------------------'.
           05  FILLER              PIC X(23) VALUE
           'ARITHMETIC CALCULATIONS'.
           05  FILLER              PIC X(22) VALUE
           '----------------------'.

       01  COL-HEADING-3.
           05  FILLER              PIC X(73) VALUE
           '  COL # DESCRIPTION                       EDIT'.
           05  FILLER              PIC X(50) VALUE
           '       OPERATIONS : + (ADD)   - (MINUS) '.

       01  COL-DETAIL-LINE.
           05  FILLER              PIC X(01) VALUE SPACES.
           05  D-COL-NO            PIC Z(02).
           05  D-COL-NO-X  REDEFINES  D-COL-NO  PIC X(02).
           05  FILLER              PIC X(04) VALUE SPACES.
           05  D-COL-DESCRIPTION-1 PIC X(15).
           05  D-COL-DESCRIPTION-2 PIC X(15).
           05  FILLER              PIC X(05) VALUE SPACES.
           05  D-COL-EDIT-TYPE     PIC X(01).
           05  FILLER              PIC X(10) VALUE SPACES.
           05  D-COL-CALCS         OCCURS 11 TIMES.
               10  D-COL-OPERAND   PIC X(05).
               10  D-COL-OPERATOR  PIC X(02).

       01  COL-ERROR-LINE  REDEFINES  COL-DETAIL-LINE.
           05  FILLER              PIC X(20).
           05  D-COL-ERROR-MSG     PIC X(50).
           05  FILLER              PIC X(49).
      /
       01  REPORT-TITLE-LINE-1.
           05  FILLER              PIC X(50) VALUE SPACES.
           05  FILLER              PIC X(23) VALUE
           '**  REPORT TITLES :  **'.

       01  REPORT-TITLE-LINE-2.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  RT2-AREA.
               10  FILLER          PIC X(19) VALUE SPACES.
               10  RT2-TITLE       PIC X(73).
               10  FILLER          PIC X(40) VALUE SPACES.

       01  REPORT-DETAIL-LINE-1.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  RD1-LINE-LITERAL    PIC X(35).
           05  RD1-FIELD           PIC X(06).
           05  FILLER              PIC X(04) VALUE SPACES.
           05  RD1-ERROR-MSG       PIC X(50) VALUE SPACES.

       01  REPORT-RUP-LINE-1.
           05  FILLER              PIC X(31) VALUE
           ' ROLLUP SEQUENCE 1       TYPE: '.
           05  RR1-RUP1-TYPE       PIC X(24).
           05  FILLER              PIC X(10) VALUE SPACES.
           05  FILLER              PIC X(31) VALUE
           ' ROLLUP SEQUENCE 2       TYPE: '.
           05  RR1-RUP2-TYPE       PIC X(24).

       01  REPORT-RUP-LINE-2.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  FILLER              PIC X(55) VALUE ALL '-'.
           05  FILLER              PIC X(10) VALUE SPACES.
           05  FILLER              PIC X(55) VALUE ALL '-'.

       01  REPORT-RUP-LINE-3.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  RR3-ROLLUP1-LEVELS.
               07  RR3-RUP1-LEVEL  PIC X(05) OCCURS 11 TIMES.
           05  FILLER              PIC X(10) VALUE SPACE.
           05  RR3-ROLLUP2-LEVELS.
               07  RR3-RUP2-LEVEL  PIC X(05)  OCCURS 11 TIMES.

       01  REPORT-RUP-LINE-4.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  RR4-RUP1-ERROR-MSG  PIC X(65) VALUE SPACES.
           05  RR4-RUP2-ERROR-MSG  PIC X(55) VALUE SPACES.

       01  REPORT-RUP-LINE-4-MSGS.
           05  RPT-ELIM-SUPP-MSG   PIC X(65) VALUE
           '* ELIMINATION LINES WILL BE SUPPRESSED *'.
           05  RPT-COL-CALC-MSG    PIC X(55) VALUE
           '* COLUMN CALCULATIONS WITHIN LINES WILL BE PERFORMED *'.

       01  REPORT-RUP-LINE-4-WORK.
           05  HOLD-REPORT-ERROR-MSG   PIC X(50)  VALUE SPACES.
      /
       01  REPORT-PERIOD-DATA-LINE-1.
           05  FILLER              PIC X(50) VALUE
           '      PRINTABLE PERIOD DATA SPECIFIED'.
           05  FILLER              PIC X(14) VALUE 'DOLLAR FLAG : '.
           05  RP1-DOLLAR-FLAG      PIC X(01).

      /
       01  REPORT-PERIOD-DATA-LINE-1-U.
           05  FILLER              PIC X(50) VALUE
           '      UNPRINTABLE PERIOD DATA SPECIFIED'.
           05  FILLER              PIC X(14) VALUE 'DOLLAR FLAG : '.

       01  REPORT-PERIOD-DATA-LINE-2.
           05  FILLER              PIC X(55) VALUE
           '  COL #   MNEMONIC     DESCRIPTION'.
           05  FILLER              PIC X(15) VALUE
           'DETECTED ERRORS'.

       01  REPORT-PERIOD-DATA-LINE-3.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  FILLER              PIC X(110) VALUE ALL '-'.

       01  REPORT-PERIOD-DATA-LINE-4.
           05  FILLER              PIC X(02) VALUE SPACE.
           05  RP4-COL-NUMBER      PIC ZZZ.
           05  FILLER              PIC X(06) VALUE SPACES.
           05  RP4-MNEMONIC        PIC X(03).
           05  FILLER              PIC X(06) VALUE SPACES.
           05  RP4-DESCRIPTION     PIC X(20).
           05  FILLER              PIC X(06) VALUE SPACES.
           05  RP4-ERROR-MSG       PIC X(50).
      /
       01  BOOK-HEADING-1.
           05  FILLER              PIC X(20) VALUE
           ' BOOK IDENTIFIER :  '.
           05  H-BOOK-ID           PIC X(8).
           05  H-BOOK-ERROR-MSG    PIC X(40) VALUE SPACES.

       01  BOOK-HEADING-2.
           05  FILLER              PIC X(20) VALUE
           ' BOOK TITLE  :      '.
           05  H-BOOK-TITLE        PIC X(80) VALUE SPACES.

       01  BOOK-HEADING-3-TITLES.
           05  BH3-TABLE-TITLE     PIC X(46) VALUE
           '***  T A B L E   D E F I N I T I O N  ***'.
           05  BH3-MEMO-TITLE      PIC X(46) VALUE
           '**********  C O V E R   M E M O  **********'.
           05  BH3-TOC-TITLE       PIC X(46) VALUE
           '***  T A B L E   O F   C O N T E N T S  ***'.

       01  BOOK-HEADING-3.
           05  FILLER              PIC X(40) VALUE SPACES.
           05  BH3-TITLE           PIC X(46) VALUE SPACES.

       01  BOOK-TABLE-LINE-1.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  BT1-BOOK-ID         PIC X(07) VALUE SPACES.
           05  FILLER              PIC X(15) VALUE 'REC TYPE : 1'.
           05  FILLER              PIC X(10) VALUE 'BOOK ID : '.
           05  BTL1-BOOK-ID        PIC X(07).
           05  FILLER              PIC X(08) VALUE 'TITLE : '.
           05  BT1-TITLE-MEMO      PIC X(75).

       01  BOOK-TABLE-LINE-2.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  BT2-BOOK-ID         PIC X(07) VALUE SPACES.
           05  FILLER              PIC X(15) VALUE 'REC TYPE : 2'.
           05  FILLER              PIC X(25) VALUE
               'NUMBER OF MANUAL PAGES : '.
           05  BT2-PAGE-COUNT      PIC X(02).
           05  FILLER              PIC X(03) VALUE SPACES.
           05  FILLER              PIC X(16) VALUE
               'MEMO/TOC LINE : '.
           05  BT2-TOC-LINE        PIC X(75).

       01  BOOK-TABLE-LINE-3-1.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  BT3-BOOK-ID         PIC X(07) VALUE SPACES.
           05  FILLER              PIC X(15) VALUE 'REC TYPE : 3'.
           05  FILLER              PIC X(17) VALUE
               'PRINT-SUPPRESS : '.
           05  BT3-PRINT-SUPP-FLAG PIC X(04).
           05  BT3-PRINT-SUPP-MSG  PIC X(08).
           05  FILLER              PIC X(30) VALUE
               'INTERLEAVED REPORT IDS : '.

       01  BOOK-TABLE-LINE-3-2.
           05  FILLER              PIC X(42) VALUE SPACES.
           05  BT3-REPORT-IDS.
               10  BT3-REPORT-ID   PIC X(05) OCCURS 18 TIMES.

       01  BOOK-TABLE-LINE-4-1.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  BT4-BOOK-ID         PIC X(07) VALUE SPACES.
           05  FILLER              PIC X(15) VALUE 'REC TYPE : 4'.
           05  FILLER              PIC X(19) VALUE
               'PRINT SEQUENCE 1 : '.
           05  BT4-RUP1-MNEMONICS.
               10  BT4-RUP1-MNEM   PIC X(05) OCCURS 11 TIMES.

       01  BOOK-TABLE-LINE-4-2.
           05  FILLER              PIC X(27) VALUE SPACES.
           05  FILLER              PIC X(19) VALUE
               'PRINT SEQUENCE 2 : '.
           05  BT4-RUP2-MNEMONICS.
               10  BT4-RUP2-MNEM   PIC X(05) OCCURS 11 TIMES.

       01  BOOK-TABLE-LINE-5-1.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  BT5-BOOK-ID         PIC X(07) VALUE SPACES.
           05  FILLER              PIC X(11) VALUE 'REC TYPE : '.
           05  BT5-REC-TYPE        PIC X(04).
           05  FILLER              PIC X(19) VALUE
               'SEQUENCE 1 CODES : '.
           05  BT5-RUP1-CODES.
               10  BT5-RUP1-CODE       OCCURS 11 TIMES.
                   15  FILLER          PIC X(03).
                   15  BT5-RUP1-SUPP   PIC X(02).

       01  BOOK-TABLE-LINE-5-2.
           05  FILLER              PIC X(27) VALUE SPACES.
           05  FILLER              PIC X(19) VALUE
               'SEQUENCE 2 CODES : '.
           05  BT5-RUP2-CODES.
               10  BT5-RUP2-CODE       OCCURS 11 TIMES.
                   15  FILLER          PIC X(03).
                   15  BT5-RUP2-SUPP   PIC X(02).

       01  BOOK-TABLE-ERROR-LINE.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  FILLER              PIC X(15) VALUE '@@@ ERROR @@@'.
           05  BTE-LINE            PIC X(80).

       01  BOOK-DETAIL-LINE.
           05  FILLER              PIC X(10) VALUE SPACE.
           05  BOOK-WARNING-MSG    PIC X(45) VALUE SPACES.
           05  BOOK-ERROR-MSG      PIC X(55) VALUE SPACES.
           05  BD-REPORT-ID        PIC X(04) VALUE SPACES.
      /
       01  BOOK-MEMO-LINE.
           05  FILLER              PIC X(01) VALUE SPACE.
           05  FILLER              PIC X(20) VALUE '-- MEMO --'.
           05  BD-MEMO-TEXT        PIC X(80) VALUE SPACES.

       01  BOOK-TOC-LINE.
           05  FILLER              PIC X(01)  VALUE SPACE.
           05  FILLER              PIC X(20)  VALUE '-- TOC  --'.
           05  BD-TOC-TEXT         PIC X(120) VALUE SPACES.
      /
       01  DIST-BOOK-LINE-1.
           05  FILLER              PIC X(05) VALUE SPACES.
           05  FILLER              PIC X(10) VALUE 'BOOK ID : '.
           05  DB-BOOK-ID          PIC X(15).
           05  DB-BOOK-COPIES-MSG  PIC X(10).
           05  DB-BOOK-COPIES      PIC 9(02).
           05  DB-BOOK-COPIES-X  REDEFINES  DB-BOOK-COPIES PIC X(02).
           05  FILLER              PIC X(05).
           05  DB-BOOK-BURST-MSG   PIC X(10).
           05  FILLER              PIC X(05).
           05  DB-BOOK-ERROR-MSG   PIC X(50).

       01  DIST-BOOK-LINE-2.
           05  FILLER              PIC X(10) VALUE SPACES.
           05  FILLER              PIC X(40) VALUE
           '    WILL BE DISTRIBUTED TO .....'.

       01  DIST-BOOK-LINE-3.
           05  FILLER              PIC X(2 ) VALUE SPACES.
           05  DB-DIST-NAME        PIC X(80).

       01  DIST-BOOK-LINE-4.
           05  FILLER              PIC X(10) VALUE SPACES.
           05  FILLER              PIC X(50) VALUE
           '    WILL RECEIVE THE FOLLOWING BOOKS .....'.

       01  DIST-ERROR-LINE.
           05  FILLER                  PIC X(10) VALUE SPACES.
           05  DIST-ERROR-REC-AREA     PIC X(90).
           05  FILLER  REDEFINES  DIST-ERROR-REC-AREA.
               10  FILLER              PIC X(20).
               10  DIST-ERROR-MSG      PIC X(50).
               10  FILLER              PIC X(20).

      /***********************************************************
      *       ERROR MESSAGES
      ************************************************************

       01  ERRMSG-REPORT-REC1-MISSING      PIC X(50) VALUE
           'ERROR #01   @@@ REPORT RECORD TYPE 1 MISSING @@@  '.
       01  ERRMSG-MISSING-REPORT-RECORD    PIC X(50) VALUE
           'ERROR #02   @@@ REPORT RECORD MISSING @@@         '.
       01  ERRMSG-INVALID-REPORT-RECORD    PIC X(50) VALUE
           'ERROR #03  @@ INVALID REPORT TABLE RECORD TYPE @  '.
       01  ERRMSG-DUP-ORG-MNEM             PIC X(50) VALUE
           'ERROR #04   @@@ DUPLICATE ORG MNEMONIC @@@        '.
       01  ERRMSG-ORG-LEVEL                PIC X(50) VALUE
           'ERROR #05 @@@ ORG KEY AT UNSPECIFIED LEVEL @@@    '.
       01  ERRMSG-DUP-ORG-KEY              PIC X(50) VALUE
           'ERROR #06   @@@ DUPLICATE ORG ROLLUP KEY @@@      '.
       01  ERRMSG-ORG-ROLLUP               PIC X(50) VALUE
           'ERROR #07 @@ ALL ROLLUP TOTAL LEVELS NOT DEFINED @'.
       01  ERRMSG-DUP-REG-MNEM             PIC X(50) VALUE
           'ERROR #08   @@@ DUPLICATE REG MNEMONIC @@@        '.
       01  ERRMSG-REG-LEVEL                PIC X(50) VALUE
           'ERROR #09    @@@ REG KEY AT UNSPECIFIED LEVEL @@@ '.
       01  ERRMSG-DUP-REG-KEY              PIC X(50) VALUE
           'ERROR #10   @@@ DUPLICATE REG ROLLUP KEY @@@      '.
       01  ERRMSG-REG-ROLLUP               PIC X(50) VALUE
           'ERROR #11 @@ ALL ROLLUP TOTAL LEVELS NOT DEFINED @'.
       01  ERRMSG-DUP-REG-SEARCH-KEY       PIC X(50) VALUE
           'ERROR #12   @@@ DUPLICATE REG SEARCH KEY @@@      '.
       01  ERRMSG-DUP-PRIME-ID             PIC X(50) VALUE
           'ERROR #13   @@@ DUPLICATE PRIME IDENTIFIER @@@    '.
       01  ERRMSG-UNDEFINED-PRIME          PIC X(50) VALUE
           'ERROR #14   @@@ UNDEFINED PRIME IN CALCULATION @@@'.
       01  ERRMSG-OVER-MAX-SUBTOTS         PIC X(50) VALUE
           'ERROR #15 @@PRIME USED IN MORE THAN 14 SUBTOTALS @'.
       01  ERRMSG-INVALID-OPERATOR         PIC X(50) VALUE
           'ERROR #16 @@@ INVALID OPERATOR IN CALCULATION @@@ '.
       01  ERRMSG-PRIME-SUBTOT-ERR         PIC X(50) VALUE
           'ERROR #17   @@@ NO CALCS FOR PRIME SUBTOT  @@@    '.
       01  ERRMSG-NON-NUM-FCST             PIC X(50) VALUE
           'ERROR #18   @@@ NON-NUMERIC FCST LINE ON PRIME @@ '.
       01  ERRMSG-INVALID-LINE-ID          PIC X(50) VALUE
           'ERROR #19   @@@ INVALID LINE TABLE IDENTIFIER @@@ '.
       01  ERRMSG-INVALID-LINE-TYPE        PIC X(50) VALUE
           'ERROR #20 @@ LINE TABLE TYPE MUST BE O, P OR R  @@'.
       01  ERRMSG-INVALID-LINE-EDIT        PIC X(50) VALUE
           'ERROR #21 @@ LINE EDIT TYPE MUST BE B,T,P,* OR SP@'.
       01  ERRMSG-NON-NUM-LINE             PIC X(50) VALUE
           'ERROR #22     @@ NON-NUMERIC LINE NUMBER @@'.
       01  ERRMSG-OVER-MAX-LINE            PIC X(50) VALUE
           'ERROR #23 @@ MAXIMUM ALLOWED LINE NUMBER IS 180 @@'.
       01  ERRMSG-OVER-MAX-LINE-CALCS      PIC X(50) VALUE
           'ERROR #24 @@  MAXIMUM ALLOWED LINE CALCS IS 16  @@'.
       01  ERRMSG-NON-SEQ-LINE             PIC X(50) VALUE
           'ERROR #25   @@ LINE NUMBER NOT IN SEQUENCE @@'.
      /
       01  ERRMSG-NON-MAX-LINE             PIC X(50) VALUE
           'ERROR #26   @@ THIS LINE NUMBER MUST BE 163 @@'.
       01  ERRMSG-INVALID-OPERAND          PIC X(50) VALUE
           'ERROR #27   @@@ INVALID OPERAND IN CALCULATION @@@'.
       01  ERRMSG-UNDEFINED-MNEMONIC       PIC X(50) VALUE
           'ERROR #28 @@ UNDEFINED IDENTIFIER IN CALCULATION @'.
       01  ERRMSG-INVALID-COL-ID           PIC X(50) VALUE
           'ERROR #29 @@INVALID COLUMN TABLE IDENTIFIER (C) @ '.
       01  ERRMSG-INVALID-COL-TYPE         PIC X(50) VALUE
           'ERROR #30 @@ COL TABLE TYPE MUST BE O,P, R OR SP@@'.
       01  ERRMSG-INVALID-COL-EDIT         PIC X(50) VALUE
           'ERROR #31 @@ COL EDIT TYPE MUST BE SPACE, B OR P @'.
       01  ERRMSG-NON-NUM-COL              PIC X(50) VALUE
           'ERROR #32 @@ NON-NUMERIC COLUMN NUMBER @@'.
       01  ERRMSG-OVER-MAX-COL             PIC X(50) VALUE
           'ERROR #33 @@ MAXIMUM ALLOWED COL NUMBER IS 56 @@'.
       01  ERRMSG-NON-SEQ-COL              PIC X(50) VALUE
           'ERROR #34 @@ COLUMN NUMBER NOT IN SEQUENCE @@'.
       01  ERRMSG-UNDEFINED-REPORT-ID      PIC X(50) VALUE
           'ERROR #35 @@@@@@@@@@ UNDEFINED REPORT @@@@@@@@@@@@'.
       01  ERRMSG-UNDEFINED-LINE-ID        PIC X(50) VALUE
           'ERROR #36 @@SPECIFIED LINE TABLE DOES NOT EXIST @'.
       01  ERRMSG-UNDEFINED-COL-ID         PIC X(50) VALUE
           'ERROR #37 @@SPECIFIED COLUMN TABLE DOES NOT EXIST'.
       01  ERRMSG-UNDEFINED-PERIOD-MNEM    PIC X(50) VALUE
           'ERROR #38 @@@ INVALID PERIOD DATA SPECIFIED @@@ '.
       01  ERRMSG-NO-PERIOD-DATA-FOR-COL   PIC X(50) VALUE
           'ERROR #39  @@ NO PERIOD DATA FOR THIS COLUMN @    '.
       01  ERRMSG-NO-COL-FOR-PERIOD-DATA   PIC X(50) VALUE
           'ERROR #40 @@NO COLUMN DEFINED ON COLUMN TABLE @   '.
       01  ERRMSG-INVALID-RUP-TYPE         PIC X(50) VALUE
           'ERROR #41 @@ PRINT SEQUENCE TYPE MUST BE O, R OR P'.
       01  ERRMSG-DUP-REPORT-ID            PIC X(50) VALUE
           'ERROR #42 @@ DUPLICATE REPORT IDENTIFIER @@       '.
       01  ERRMSG-INVALID-PAGE-BREAK       PIC X(50) VALUE
           'ERROR #43 @@ PAGE BREAK INVALID (1, 2 OR BLANK) @@'.
       01  ERRMSG-INVALID-REPORT-FORMAT    PIC X(50) VALUE
           'ERROR #44 @@ INVALID REPORT FORMAT (A,B,C,D,E) @@ '.
       01  ERRMSG-UNDEFINED-ORG            PIC X(50) VALUE
           'ERROR #45 @@ SPECIFIED ORG TABLE DOES NOT EXIST @@'.
       01  ERRMSG-UNDEFINED-REG            PIC X(50) VALUE
           'ERROR #46 @@ SPECIFIED REG TABLE DOES NOT EXIST @@'.
       01  ERRMSG-UNDEFINED-RPT-PRIME      PIC X(50) VALUE
           'ERROR #47 @@ SPECIFIED PRIME NOT IN PRIME TABLE @@'.
       01  ERRMSG-UNDEFINED-RUP            PIC X(50) VALUE
           'ERROR #48 @@SPECIFIED ROLLUP LEVEL DOES NOT EXIST '.
       01  ERRMSG-NO-ORG-SPECIFIED         PIC X(50) VALUE
           'ERROR #49 @@ NO ORG SPECIFIED IN L/C/PS1/PS2  @@'.
       01  ERRMSG-NO-REG-SPECIFIED         PIC X(50) VALUE
           'ERROR #50 @@ NO REG SPECIFIED IN L/C/PS1/PS2  @@'.
       01  ERRMSG-NO-PRIME-SPECIFIED       PIC X(50) VALUE
           'ERROR #51 @@NO PRIME SPECIFIED IN L/C/PS1/PS2  @'.
       01  ERRMSG-MULT-ORG-SPECIFIED       PIC X(50) VALUE
           'ERROR #52 @@ > 1 ORG SPECIFIED IN L/C/PS1/PS2  @'.
      /
       01  ERRMSG-MULT-REG-SPECIFIED       PIC X(50) VALUE
           'ERROR #53 @@ > 1 REG SPECIFIED IN L/C/PS1/PS2  @'.
       01  ERRMSG-MULT-PRIME-SPECIFIED     PIC X(50) VALUE
           'ERROR #54 @@> 1 PRIME SPECIFIED IN L/C/PS1/PS2 @'.
       01  ERRMSG-UNDEFINED-BOOK           PIC X(50) VALUE
           'ERROR #55 @@  UNDEFINED BOOK   @@                 '.
       01  ERRMSG-DOUBLE-BOOK              PIC X(50) VALUE
           'ERROR #56 @@ BOOK DEFINED TWICE IN TABLE @@       '.
       01  ERRMSG-INVALID-RUP              PIC X(50) VALUE
           'ERROR #57 @@@ PRINT ROLLUP LEVEL NOT SPECIFIED @@@'.
       01  ERRMSG-RUP-MATCH                PIC X(50) VALUE
           'ERROR #58 @@PRINT LEVEL NOT DEFINED ON THIS REPORT'.
       01  ERRMSG-WARNING                  PIC X(50) VALUE
           'ERROR #59 @@  WARNING ONLY  @@                    '.
       01  ERRMSG-NO-RUP-MATCH             PIC X(50) VALUE
           'ERROR #60 @@@ NO MATCHING PRINT LEVELS FOR REPORT '.
       01  ERRMSG-RUP-CONFLICT             PIC X(50) VALUE
           'ERROR #61 @@ PRINT SEQUENCE CONFLICT ON BOOK @@   '.
       01  ERRMSG-ORG-CONFLICT             PIC X(50) VALUE
           'ERROR #62 @@INTERLEAVED REPORTS HAVE ORG CONFLICT '.
       01  ERRMSG-REG-CONFLICT             PIC X(50) VALUE
           'ERROR #63 @@INTERLEAVED REPORTS HAVE REG CONFLICT '.
       01  ERRMSG-NO-SELECTION             PIC X(50) VALUE
           'ERROR #64 @@ NO SELECTION MADE FOR THESE LEVELS @@'.
       01  ERRMSG-NO-REC6-LITERAL          PIC X(50) VALUE
           'ERROR #65 @@NO LITERAL SPECIFIED ON RECORD TYPE 6 '.
       01  ERRMSG-UNMATCHED-REC6           PIC X(50) VALUE
           'ERROR #66 @@RECORD TYPE 6 UNMATCHED WITH ANOTHER @'.
       01  ERRMSG-INVALID-DIST-REC-TYPE    PIC X(50) VALUE
           'ERROR #67 @@DIST RECORD TYPE MUST BE 1 OR 2 ONLY @'.
       01  ERRMSG-NON-NUMERIC-COPIES       PIC X(50) VALUE
           'ERROR #68 @@@ NUMBER OF COPIES NOT NUMERIC @@@    '.
       01  ERRMSG-OVER-MAX-COPIES          PIC X(50) VALUE
           'ERROR #69 @@@ MAXIMUM ALLOWED COPIES IS 30 @@@    '.
       01  ERRMSG-UNPRINTABLE-COL-CALC     PIC X(50) VALUE
           'ERROR #70 @@ NOT ALLOWED ON UNPRINTABLE COLS @@   '.
       01  ERRMSG-REC-TYPE-1               PIC X(50) VALUE
           'ERROR #71 @@ REC TYPE 1S MUST BE CONSECUTIVE @@   '.
       01  ERRMSG-TOO-MANY-COLUMNS         PIC X(50) VALUE
           'ERROR #72 @@ TOO MANY COLUMNS FOR REPORT FORMAT @@'.
       01  ERRMSG-CALC-FILE-OVERFLOW       PIC X(50) VALUE
           'ERROR #73 @@@@@@@ CALCULATOR FILE OVERFLOW @@@@@@@'.
       01  ERRMSG-SUBACCT-CALC             PIC X(50) VALUE
           'ERROR #74 @@ CALCS NOT ALLOWED ON SUBACCT DEF LINE'.
       01  ERRMSG-TOO-MANY-TYPE-4          PIC X(50) VALUE
           'ERROR #75 @@ ONLY 4 TYPE 4 RECORDS ALLOWED @@     '.

      /
      *******   PERIOD HEADINGS WORK AREAS   *******

      ************  PERIOD MNEMONIC TABLE ***************************
       01  PERIOD-MNEMONIC-TABLE-AREA.
           05  PERIOD-MNEMONIC-LITERALS.
               10  FILLER         PIC X(80) OCCURS 256 TIMES.
           05  PERIOD-MNEMONIC-RECORD
                       REDEFINES  PERIOD-MNEMONIC-LITERALS
                                  OCCURS 256 TIMES
                                  ASCENDING KEY PERIOD-MNEMONIC
                                  INDEXED BY PER-MNEM-INDEX.
               10  FILLER               PIC X(08).
               10  PERIOD-MNEMONIC      PIC X(03).
               10  PERIOD-MNEMONIC-HDG.
                   15  PERIOD-MNEMONIC-HDG1.
                       20  FILLER           PIC X(06).
                       20  PERIOD-MNEM-PER  PIC X(02).
                       20  FILLER           PIC X(01).
                   15  PERIOD-MNEMONIC-HDG2 PIC X(09).
                   15  FILLER               PIC X(51).
               10  PERIOD-MNEMONIC-HDG-X
                     REDEFINES PERIOD-MNEMONIC-HDG.
                   15  PERIOD-MNEMONIC-HDG1-X.
                       20  FILLER               PIC X(04).
                       20  APOSTROPHE-X         PIC X(01).
                       20  YEAR-MNEM-YR         PIC X(02).
                       20  FILLER               PIC X(02).
                   15  PERIOD-MNEMONIC-HDG2-X   PIC X(09).
                   15  FILLER                   PIC X(51).
           05  PERIOD-MNEM-RECORD
                       REDEFINES  PERIOD-MNEMONIC-LITERALS
                           OCCURS 256 TIMES.
               10  FILLER                        PIC X(08).
               10  PERIOD-MNEM-PERIOD-MNEMONIC   PIC X(03).
               10  PERIOD-MNEM-DEFAULT-HEADING-1 PIC X(09).
               10  PERIOD-MNEM-DEFAULT-HEADING-2 PIC X(09).
               10  FILLER                        PIC X(03).
               10  PERIOD-MNEM-REL-FLAG          PIC X(01).
               10  FILLER                        PIC X(05).
               10  PERIOD-MNEM-CALC-PARMS.
                   15  PERIOD-MNEM-AVG-FLAG      PIC X(01).
                   15  FILLER                    PIC X(05).
                   15  PERIOD-MNEM-FCST-FLAG     PIC X(01).
                   15  FILLER                    PIC X(06).
                   15  PERIOD-MNEM-BEG-INDEX     PIC 9(02).
                   15  FILLER                    PIC X(04).
                   15  PERIOD-MNEM-END-INDEX     PIC 9(02).
                   15  FILLER                    PIC X(04).
                   15  PERIOD-MNEM-NO-REPS       PIC 9(02).
                   15  FILLER                    PIC X(04).
                   15  PERIOD-MNEM-DIVISOR       PIC 9(02).
                   15  FILLER                    PIC X(05).
                   15  PERIOD-MNEM-BAL-INDEX     PIC 9(02).
                   15  FILLER                    PIC X(02).
      ************  PERIOD MNEMONIC POINTER TABLE *******************
       01  PERIOD-MNEM-POINTER-TABLE-AREA.
           05  PERIOD-MNEMONIC-POINTER-RECORD OCCURS 256 TIMES.
               10  FILLER               PIC X(02).
               10  TABLE-TYPE           PIC X(01).
               10  FILLER               PIC X(01).
               10  FIXED-INDEX          PIC X(03).
               10  FILLER               PIC X(02).
               10  PERIOD-MNEM-POINTER  PIC X(03).
               10  FILLER               PIC X(02).
               10  DESCRIPTOR           PIC X(21).
               10  FILLER               PIC X(45).

       COPY C231WDTF.

       01  GL-HEADER-RECORD.
           05  FILLER                 PIC X(102).
           05  GL-H-PER-END-MONTH     PIC 9(02).
           05  GL-H-PER-END-DAY       PIC 9(02).
           05  GL-H-PER-END-YEAR      PIC 9(02).
           05  FILLER                 PIC X(01).
           05  GL-H-CURR-PERIOD       PIC 9(02).
           05  FILLER                 PIC X(04).
           05  GL-H-FISCAL-YEAR       PIC 9(02).
           05  FILLER                 PIC X(935).
      /
       01  PERIOD-UPDATE-WORK-FIELDS.
           05  CURR-QUARTER           PIC S9(02).
           05  WORK-QUARTER           PIC S9(02).
           05  CURR-PERIOD            PIC S9(02).
           05  WORK-PERIOD            PIC S9(02).
           05  WORK-YEAR              PIC S9(02).
           05  APOSTROPHE             PIC X(01) VALUE QUOTE.
           05  ALPHA-PERIOD           PIC X(02).
           05  NUM-PERIOD REDEFINES  ALPHA-PERIOD   PIC 9(02).
           05  PER-MNEM-WORK.
               10  PER-MNEM-1-2.
                   15  PER-MNEM-1     PIC X(01).
                   15  PER-MNEM-2     PIC X(01).
               10  PER-MNEM-3         PIC X(01).
      /
       01  MONTH-NAME-TABLE.
           05  MONTH-LITERALS.
               10  FILLER             PIC X(03) VALUE 'JAN'.
               10  FILLER             PIC X(03) VALUE 'FEB'.
               10  FILLER             PIC X(03) VALUE 'MAR'.
               10  FILLER             PIC X(03) VALUE 'APR'.
               10  FILLER             PIC X(03) VALUE 'MAY'.
               10  FILLER             PIC X(03) VALUE 'JUN'.
               10  FILLER             PIC X(03) VALUE 'JUL'.
               10  FILLER             PIC X(03) VALUE 'AUG'.
               10  FILLER             PIC X(03) VALUE 'SEP'.
               10  FILLER             PIC X(03) VALUE 'OCT'.
               10  FILLER             PIC X(03) VALUE 'NOV'.
               10  FILLER             PIC X(03) VALUE 'DEC'.
           05  MONTH-NAME  REDEFINES  MONTH-LITERALS
                                      PIC X(03) OCCURS 12 TIMES.

       01  W0001-CURRENT-DATE-AND-TIME.
           05  W0001-CURRENT-FR-DATE.
               10  W0001-CURRENT-FR-YY   PIC  X(02).
               10  W0001-CURRENT-FR-MM   PIC  X(02).
               10  W0001-CURRENT-FR-DD   PIC  X(02).
           05  W0001-CURRENT-TO-DATE.
               10  W0001-CURRENT-TO-MM   PIC  X(02).
               10  FILLER                PIC  X(01) VALUE '/'.
               10  W0001-CURRENT-TO-DD   PIC  X(02).
               10  FILLER                PIC  X(01) VALUE '/'.
               10  W0001-CURRENT-TO-YY   PIC  X(02).
           05  W0001-CURRENT-DATE REDEFINES
               W0001-CURRENT-TO-DATE     PIC  X(08).

           05  W0001-CURRENT-FR-TIME.
               10  W0001-CURRENT-FR-HH   PIC  X(02).
               10  W0001-CURRENT-FR-MN   PIC  X(02).
               10  W0001-CURRENT-FR-SS   PIC  X(02).
               10  FILLER                PIC  X(03).
           05  W0001-CURRENT-TO-TIME.
               10  W0001-CURRENT-TO-HH   PIC  X(02).
               10  W0001-CURRENT-TO-MN   PIC  X(02).
               10  W0001-CURRENT-TO-SS   PIC  X(02).
           05  W0001-CURRENT-TIME REDEFINES
               W0001-CURRENT-TO-TIME     PIC  9(06).

       01  W0002-PRINTER-REC             PIC X(133).

       01  W0003-PRINT-AREAS.
           05  W0003-LINE-TYPE.
               10  FILLER                PIC X(001) VALUE SPACES.
               10  W0003-LINE-TYPE-DESC  PIC X(132) VALUE SPACES.
           05  W0003-DETAIL-LINE.
               10  FILLER                PIC X(001) VALUE SPACES.
               10  W0003-DETAIL-DATA     PIC X(132) VALUE SPACES.

       01  W9999-ERROR-MESSAGE-DISPLAY.
           05  W9999-ERROR-MESSAGE-FIELDS.
               10  W9999-ERROR-MESSAGE-1 PIC  X(132) VALUE SPACES.
               10  W9999-ERROR-MESSAGE-2 PIC  X(132) VALUE SPACES.
               10  W9999-ERROR-MESSAGE-3 PIC  X(132) VALUE SPACES.
      /
       PROCEDURE DIVISION.
      ***************************************************************
       0000-MAINLINE.
      ***************************************************************
           MOVE 'SRTPRT' TO SORT-MESSAGE.
           MOVE COUNT-MASK TO ORG-COUNTS.
           MOVE COUNT-MASK TO REG-COUNTS.
           MOVE ZERO TO
               CTR-DTF
               CTR-BDX
               CTR-DBF
               CTR-TCM
               CTR-EXB
               CTR-PXT
               CTR-ORC
               CTR-OTF
               CTR-RTF
               CTR-LDF
               CTR-LCF
               CTR-CBF
               CTR-RDF
               CTR-OCF
               CTR-PCF
               CTR-RCF
               CTR-PRF
               CTR-RRF
               CTR-FRF
               CTR-ORF
               CTR-RMF.
           PERFORM 8000-PERIOD-UPDATE.
           OPEN OUTPUT PRINTER
                       ERRORS.

           MOVE '================   FDAT EDIT ERRORS   =============='
             TO FD-ERROR-AREA.
           WRITE FD-ERRORS-REC AFTER ADVANCING PAGE.

           MOVE ALL '-' TO FD-ERROR-AREA.
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.

           PERFORM 1000-SELECT-REPORTS-FOR-RUN.
           PERFORM 2000-LOAD-REPORT-TABLE.
           PERFORM 3000-EDIT-ORG-TABLE.
           PERFORM 4000-EDIT-REG-TABLE.
           PERFORM 5000-EDIT-PRIME-TABLE.
           PERFORM 6000-EDIT-LINE-TABLE.
           PERFORM 7000-EDIT-COLUMN-TABLE.
           PERFORM 9000-EDIT-REPORT-DEFINITIONS.
           PERFORM 10000-EDIT-BOOK-DEFINITIONS.
           PERFORM 11000-EDIT-DISTRIBUTION-TABLE.
      *
           DISPLAY ':::::::::::::::::::::::::::::::::::::::::::::::'
                   ':::::::::::::'.
           DISPLAY '::                                             '
                   '           ::'.
           IF  ERROR-COUNT > 0
               DISPLAY ':: DO A FIND ON "@@" TO LOCATE THE SPECIFIC '
                       'ERROR MESSAGE ::'
               DISPLAY '::                                          '
                       '              ::'
           END-IF.
           DISPLAY ':: PROGRAM P231EDIT NUMBER OF DETECTED ERRORS = '
                   ERROR-COUNT '     ::'.
           DISPLAY '::                                             '
                   '           ::'.
           DISPLAY ':::::::::::::::::::::::::::::::::::::::::::::::'
                   ':::::::::::::'.

           MOVE ALL ':' TO W0003-DETAIL-DATA.
           WRITE FD-ERRORS-REC  FROM  W0003-DETAIL-DATA
               AFTER ADVANCING 1 LINES.

           MOVE ':: PROGRAM P231EDIT NUMBER OF DETECTED ERRORS = '
             TO W0003-DETAIL-DATA.
           MOVE ERROR-COUNT
             TO W0003-DETAIL-DATA(50:15).
           WRITE FD-ERRORS-REC  FROM  W0003-DETAIL-DATA
               AFTER ADVANCING 1 LINES.

           MOVE ALL ':' TO W0003-DETAIL-DATA.
           WRITE FD-ERRORS-REC  FROM  W0003-DETAIL-DATA
               AFTER ADVANCING 1 LINES.
      *

           IF  MASTER-ERROR-SWITCH  =  'N'
               PERFORM 12000-WRITE-INTERNAL-TABLES
           END-IF.

           CLOSE PRINTER
                 PRINTER2
                 ERRORS.
           DISPLAY '@ PROGRAM P231EDIT NUMBER OF DETECTED ERRORS = '
                   ERROR-COUNT     UPON CONSOLE.

           GOBACK.

      /**************************************************************
       1000-SELECT-REPORTS-FOR-RUN.
      ***************************************************************
           OPEN INPUT IN-DIST-FILE
                OUTPUT BOOK-TO-DIST-FILE
                OUTPUT DIST-BOOK-FILE.

           SORT SORT-FILE ON ASCENDING   SD-BOOK-ID
               INPUT PROCEDURE IS  1010-SELECT-BOOK-IDS
                             THRU  1049-EXIT
               OUTPUT PROCEDURE IS 1050-BUILD-BD-XREF
                             THRU  1099-EXIT.

           MOVE BDX-COUNT TO CTR-BDX.
           MOVE DBF-COUNT TO CTR-DBF.

           CLOSE IN-DIST-FILE
                 BOOK-TO-DIST-FILE
                 DIST-BOOK-FILE.

           OPEN INPUT IN-BOOK-FILE.

           SORT SORT-FILE ON ASCENDING   SD-REPORT-ID
               INPUT PROCEDURE IS  1100-SELECT-REPORT-IDS
                             THRU  1149-EXIT
               OUTPUT PROCEDURE IS 1150-BUILD-REPORT-ID-TABLE
                             THRU  1179-EXIT.

           CLOSE IN-BOOK-FILE.

      ******************************************************************
       1010-SELECT-BOOK-IDS.
      ******************************************************************
           MOVE SPACES TO IN-DIST-FILE-STATUS.
           MOVE SPACES TO DIST-NAME-TABLE.
           MOVE HIGH-VALUES TO DIST-BOOK-TABLE.

           PERFORM 1020-READ-IN-DIST-FILE.

           IF  NOT END-OF-DIST-FILE
               MOVE ZERO TO DIST-INDEX
               PERFORM 1030-CHECK-DIST-RECORDS
                   UNTIL  END-OF-DIST-FILE
           ELSE
               DISPLAY '@@ NO RECORDS ON DIST FILE @@'
               MOVE '@@ NO RECORDS ON DIST FILE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           GO TO 1049-EXIT.

      ******************************************************************
       1020-READ-IN-DIST-FILE.
      ******************************************************************
           PERFORM 1025-READ-IN-DIST-FILE.
           PERFORM 1025-READ-IN-DIST-FILE UNTIL
              (IN-DIST-ID-1 IS NOT = '/') OR
               END-OF-DIST-FILE.
      ******************************************************************
       1025-READ-IN-DIST-FILE.
      ******************************************************************
           READ IN-DIST-FILE  INTO  IN-DIST-REC
               AT END
                   MOVE 'EOF' TO IN-DIST-FILE-STATUS.
      /*****************************************************************
       1030-CHECK-DIST-RECORDS.
      ******************************************************************
           IF  IN-DIST-REC-TYPE  =  '1'
               ADD 1 TO DIST-INDEX
               MOVE DIST-INDEX TO DBT-DIST-INDEX (DIST-INDEX)
               MOVE IN-DIST-NAME TO DIST-NAME (DIST-INDEX)
               MOVE IN-DIST-NAME TO DBT-DIST-NAME (DIST-INDEX)
               MOVE ZERO TO DBT-BOOK-ENTRY-INDEX (DIST-INDEX)
           END-IF.

           IF  DIST-INDEX  >  MAX-DISTRIBUTEES
               DISPLAY '@@ ERROR - DIST-COUNT OVER 50 @@'
               DISP AY '@@  INCREASE PRINTERS IN FORMATTER PGM   @@'
               MOVE '@@ ERROR - DIST-COUNT OVER 50 @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE PRINTERS IN FORMATTER PGM   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

           IF  IN-DIST-REC-TYPE  =  '2'
               PERFORM 1040-BUILD-SORT-RECORDS
                   VARYING DIST-BOOK-INDEX FROM 1 BY 1
                   UNTIL  DIST-BOOK-INDEX  >  MAX-BOOKS-ON-DIST-DEF
                      OR  IN-DIST-BOOK-ID (DIST-BOOK-INDEX)
                               =  SPACES
           END-IF.

           PERFORM 1020-READ-IN-DIST-FILE.

      ******************************************************************
       1040-BUILD-SORT-RECORDS.
      ******************************************************************
           IF  IN-DIST-BOOK-COPIES (DIST-BOOK-INDEX)  IS NUMERIC
               IF  IN-DIST-BOOK-COPIES (DIST-BOOK-INDEX) > ZERO
                   MOVE IN-DIST-BOOK-COPIES (DIST-BOOK-INDEX)
                          TO  SD-BOOK-COPIES
                   MOVE IN-DIST-BURST-FLAG (DIST-BOOK-INDEX)
                          TO  SD-BOOK-BURST-FLAG
                   MOVE IN-DIST-BOOK-ID (DIST-BOOK-INDEX)
                              TO SD-BOOK-ID
                   MOVE DIST-INDEX TO SD-DIST-INDEX
                   RELEASE SD-BOOK-REC
               END-IF
           END-IF.

      ******************************************************************
       1049-EXIT.
           EXIT.
      ******************************************************************
      /*****************************************************************
       1050-BUILD-BD-XREF.
      ******************************************************************
           MOVE HIGH-VALUES TO BDX-TABLE.
           MOVE SPACES TO SORT-FILE-STATUS.
           PERFORM 1060-RETURN-SORT-RECORD.
           SET BDX-INDEX TO 1.
           MOVE SD-BOOK-ID TO BDX-TBL-BOOK-ID (BDX-INDEX).
      *    DISPLAY ' * LOADED BOOK ID ' SD-BOOK-ID.
           MOVE SD-BOOK-ID TO SAVE-BOOK-ID.
           SET BDX-DIST-INDEX TO 1.
           PERFORM 1070-LOAD-DIST-IDS
               UNTIL  END-OF-SORT-FILE.

           PERFORM 1080-WRITE-BD-XREF
               VARYING BDX-INDEX FROM 1 BY 1
               UNTIL  BDX-INDEX  >  MAX-BDX
                  OR  BDX-TABLE-ENTRY (BDX-INDEX)  =  HIGH-VALUES.

           PERFORM 1090-WRITE-DBT-RECORDS
               VARYING WORK-INDEX FROM 1 BY 1
               UNTIL  WORK-INDEX  >  MAX-DISTRIBUTEES
                  OR  DBT-ENTRY (WORK-INDEX)  =  HIGH-VALUES.

           GO TO 1099-EXIT.

      ******************************************************************
       1060-RETURN-SORT-RECORD.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      /*****************************************************************
       1070-LOAD-DIST-IDS.
      ******************************************************************
           IF  SD-BOOK-ID NOT =  SAVE-BOOK-ID
               SET BDX-INDEX UP BY 1
               MOVE SD-BOOK-ID TO BDX-TBL-BOOK-ID (BDX-INDEX)
               MOVE SD-BOOK-ID TO SAVE-BOOK-ID
               SET BDX-DIST-INDEX TO 1
           END-IF.

           IF  BDX-INDEX >  MAX-BDX
               DISPLAY '@@ ERROR - BOOK-COUNT OVER 100 @@'
               DISPLAY '@@  INCREASE BDX TABLE SIZE   @@'
               MOVE '@@ ERROR - BOOK-COUNT OVER 100 @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE BDX TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

           MOVE SD-DIST-INDEX
               TO BDX-TABLE-DIST (BDX-INDEX, BDX-DIST-INDEX).
           SET DIST-COUNT TO BDX-DIST-INDEX.
           SET BDX-DIST-INDEX UP BY 1.

           IF  BDX-DIST-INDEX  >  MAX-DISTRIBUTEES
               DISPLAY '@@ ERROR - DIST-COUNT OVER 50 @@'
               DISPLAY '@@  INCREASE PRINTERS IN FORMATTER PGM   @@'
               MOVE '@@ ERROR - DIST-COUNT OVER 50 @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE PRINTERS IN FORMATTER PGM   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

           ADD 1 TO DBT-BOOK-ENTRY-INDEX (SD-DIST-INDEX).
           MOVE DBT-BOOK-ENTRY-INDEX (SD-DIST-INDEX) TO WORK-INDEX.

           IF  WORK-INDEX  >  MAX-BOOKS-ON-DIST
               DISPLAY '@@ ERROR - BOOK COUNT OVER 45 FOR 1 DIST @@ '
                       SD-DIST-INDEX
               DISPLAY '@@  RE-CODE DISTRIBUTION TABLE  @@'
               MOVE '@@ ERROR - BOOK COUNT OVER 45 FOR 1 DIST @@ '
                 TO W9999-ERROR-MESSAGE-1
               MOVE SD-DIST-INDEX
                 TO W9999-ERROR-MESSAGE-2
               MOVE '@@  RE-CODE DISTRIBUTION TABLE  @@'
                 TO W9999-ERROR-MESSAGE-3
               PERFORM 99999-ABORT
           END-IF.

           MOVE SD-BOOK-ID TO
                    DBT-BOOK-ID (SD-DIST-INDEX, WORK-INDEX).
           MOVE SD-BOOK-COPIES TO
                    DBT-BOOK-COPIES (SD-DIST-INDEX, WORK-INDEX).
           MOVE SD-BOOK-BURST-FLAG TO
                    DBT-BOOK-BURST-FLAG (SD-DIST-INDEX, WORK-INDEX).

           PERFORM 1060-RETURN-SORT-RECORD.

      ******************************************************************
       1080-WRITE-BD-XREF.
      ******************************************************************
           MOVE BDX-TABLE-ENTRY (BDX-INDEX) TO BDX-RECORD.
           WRITE FD-BOOK-TO-DIST-FILE-REC  FROM  BDX-RECORD.
           ADD 1 TO BDX-COUNT.
      ******************************************************************
       1090-WRITE-DBT-RECORDS.
      ******************************************************************
           MOVE DBT-ENTRY (WORK-INDEX) TO DBF-RECORD.
           WRITE FD-DIST-BOOK-FILE-REC  FROM  DBF-RECORD.
           ADD 1 TO DBF-COUNT.
      ******************************************************************
       1099-EXIT.
           EXIT.
      /*****************************************************************
       1100-SELECT-REPORT-IDS.
      ******************************************************************
           MOVE SPACES TO BOOK-NAME-TABLE.
           MOVE SPACES TO IN-BOOK-FILE-STATUS.
           PERFORM 1110-READ-IN-BOOK-FILE.

           IF  NOT END-OF-BOOK-FILE
               PERFORM 1120-PROCESS-BOOK-RECORDS
                   UNTIL  END-OF-BOOK-FILE
           ELSE
               DISPLAY '@@ NO RECORDS ON BOOK FILE @@'
               MOVE '@@ NO RECORDS ON BOOK FILE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           GO TO 1149-EXIT.

      ******************************************************************
       1110-READ-IN-BOOK-FILE.
      ******************************************************************
           PERFORM 1115-READ-IN-BOOK-FILE.
           PERFORM 1115-READ-IN-BOOK-FILE UNTIL
               (IN-BOOK-ID-1 IS NOT = '/') OR
                   END-OF-BOOK-FILE.
      ******************************************************************
       1115-READ-IN-BOOK-FILE.
      ******************************************************************
           READ IN-BOOK-FILE  INTO  IN-BOOK-REC
               AT END
                   MOVE 'EOF' TO IN-BOOK-FILE-STATUS.
      ***************************************************************
       1120-PROCESS-BOOK-RECORDS.
      ******************************************************************
           IF  IN-BOOK-REC-TYPE  =  '1'
               MOVE IN-BOOK-ID TO SAVE-BOOK-ID
               MOVE IN-BOOK-TITLE-MEMO TO SAVE-BOOK-NAME
           END-IF.

           IF  IN-BOOK-REC-TYPE  =  '3'
               PERFORM 1130-SEARCH-FOR-BOOK
           END-IF.

           PERFORM 1110-READ-IN-BOOK-FILE.

      ******************************************************************
       1130-SEARCH-FOR-BOOK.
      ******************************************************************
           MOVE SPACES TO BOOK-FOUND-FLAG.

           SEARCH ALL BDX-TABLE-ENTRIES
               WHEN  BDX-TBL-BOOK-ID (BDX-INDEX)  =  SAVE-BOOK-ID
                   SET BOOK-INDEX TO BDX-INDEX
                   MOVE SAVE-BOOK-NAME TO BOOK-NAME (BOOK-INDEX)
                   MOVE 'Y' TO BOOK-FOUND-FLAG.

           IF  BOOK-FOUND-FLAG  =  'Y'
               PERFORM 1140-PROCESS-REPORT-IDS
                   VARYING BOOK-REPORT-INDEX FROM 1 BY 1
                   UNTIL  BOOK-REPORT-INDEX  >  MAX-RPTS-ON-BOOK
                      OR  IN-BOOK-REPORT-ID (BOOK-REPORT-INDEX)
                          =  SPACES
           END-IF.

      /*****************************************************************
       1140-PROCESS-REPORT-IDS.
      ******************************************************************
           MOVE IN-BOOK-REPORT-ID (BOOK-REPORT-INDEX)
               TO SD-REPORT-ID.
           RELEASE SD-REPORT-REC.
      ******************************************************************
       1149-EXIT.
           EXIT.
      /*****************************************************************
       1150-BUILD-REPORT-ID-TABLE.
      ******************************************************************
           MOVE HIGH-VALUES TO REPORT-TABLE.
           PERFORM 1160-RETURN-SORT-RECORD.
           SET REPORT-INDEX TO 1.
           MOVE SD-REPORT-ID TO RDT-REPORT-ID (REPORT-INDEX).
           MOVE SD-REPORT-ID TO SAVE-REPORT-ID.

           PERFORM 1170-PROCESS-REPORT-SORT-RECS
               UNTIL  END-OF-SORT-FILE.

           SET REPORT-COUNT TO REPORT-INDEX.

           GO TO 1179-EXIT.

      ******************************************************************
       1160-RETURN-SORT-RECORD.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS.
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       1170-PROCESS-REPORT-SORT-RECS.
      ******************************************************************
           IF  SD-REPORT-ID  NOT =  SAVE-REPORT-ID
               SET REPORT-INDEX UP BY 1
               IF  REPORT-INDEX  NOT >  MAX-RDT
                   MOVE SD-REPORT-ID TO RDT-REPORT-ID (REPORT-INDEX)
                   MOVE SD-REPORT-ID TO SAVE-REPORT-ID
               ELSE
                   DISPLAY '@@ ERROR - REPORT COUNT OVER 150 @@'
                   DISPLAY '@@  INCREASE RDF TABLE SIZE   @@'
                   MOVE '@@ ERROR - REPORT COUNT OVER 150 @@'
                     TO W9999-ERROR-MESSAGE-1
                   MOVE '@@  INCREASE RDF TABLE SIZE   @@'
                     TO W9999-ERROR-MESSAGE-2
                   PERFORM 99999-ABORT
               END-IF
           END-IF.

           PERFORM 1160-RETURN-SORT-RECORD.
      ******************************************************************
       1179-EXIT.
      ******************************************************************
           EXIT.
      /**************************************************************
       2000-LOAD-REPORT-TABLE.
      ***************************************************************
           OPEN INPUT IN-REPORT-FILE.
           PERFORM 2010-READ-IN-REPORT-FILE.
           PERFORM 2020-PROCESS-REPORT-RECORDS
               UNTIL  END-OF-REPORT-FILE.
      ******************************************************************
       2010-READ-IN-REPORT-FILE.
      ******************************************************************
           PERFORM 2015-READ-IN-REPORT-FILE.
           PERFORM 2015-READ-IN-REPORT-FILE UNTIL
               (IN-REPORT-ID-1 IS NOT = '/') OR
                   END-OF-REPORT-FILE.
      ******************************************************************
       2015-READ-IN-REPORT-FILE.
      ******************************************************************
           MOVE SPACES TO IN-REPORT-FILE-STATUS.
           READ IN-REPORT-FILE  INTO  IN-REPORT-REC
               AT END
                   MOVE 'EOF' TO IN-REPORT-FILE-STATUS.
      ******************************************************************
       2020-PROCESS-REPORT-RECORDS.
      ******************************************************************
           IF  IN-REPORT-REC-TYPE  =  '1'
               PERFORM  2030-SEARCH-FOR-REPORT
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               DISPLAY ERRMSG-REPORT-REC1-MISSING IN-REPORT-REC
               MOVE ERRMSG-REPORT-REC1-MISSING TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
               PERFORM 2010-READ-IN-REPORT-FILE
                   UNTIL  IN-REPORT-REC-TYPE  =  '1'
                      OR  END-OF-REPORT-FILE
           END-IF.
      ******************************************************************
       2030-SEARCH-FOR-REPORT.
      ******************************************************************
           SEARCH ALL REPORT-TABLE-ENTRIES
               AT END
                    MOVE IN-REPORT-ID TO SAVE-REPORT-ID
                    PERFORM 2035-BYPASS-REPORT-ID
               WHEN RDT-REPORT-ID (REPORT-INDEX)  =  IN-REPORT-ID
                    PERFORM 2040-MOVE-REPORT-RECORDS
                    MOVE RDF-RECORD
                          TO REPORT-TABLE-ENTRY (REPORT-INDEX).
      ******************************************************************
       2035-BYPASS-REPORT-ID.
      ******************************************************************
           PERFORM 2010-READ-IN-REPORT-FILE
               UNTIL  IN-REPORT-ID NOT = SAVE-REPORT-ID
                  OR  END-OF-REPORT-FILE.
      /*****************************************************************
       2040-MOVE-REPORT-RECORDS.
      ******************************************************************
           MOVE IN-REPORT-ID TO RDF-REPORT-ID.
           MOVE IN-REPORT-PAGE-BREAK TO RDF-PAGE-BREAK.
           MOVE IN-REPORT-FORMAT TO RDF-FORMAT-TYPE.
           MOVE IN-REPORT-ELIM-FLAG TO RDF-ELIM-SUPP-FLAG.
           MOVE IN-REPORT-COL-FLAG TO RDF-COL-CALC-FLAG.
           MOVE IN-REPORT-ORG-ID TO RDF-ORG-ID.
           MOVE IN-REPORT-REG-ID TO RDF-REG-ID.
           MOVE IN-REPORT-LINE-ID-2-3 TO RDF-LINE-ID.
           MOVE IN-REPORT-COL-ID-2-3 TO RDF-COLUMN-ID.
           MOVE IN-REPORT-TOC-DESC TO RDF-TOC-DESCRIPTION.
           MOVE 2 TO REPORT-REC-COUNT.
           MOVE IN-REPORT-ID TO SAVE-REPORT-ID.
           PERFORM 2010-READ-IN-REPORT-FILE.
           MOVE 1 TO RDF-PERIOD-INDEX.
           MOVE SPACES TO RDF-PERIOD-MNEMONICS.

           IF  IN-REPORT-REC-TYPE  =  '2'
               PERFORM 2050-LOAD-REPORT-RECORDS
                   UNTIL  IN-REPORT-ID  NOT =  SAVE-REPORT-ID
                      OR  END-OF-REPORT-FILE
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-MISSING-REPORT-RECORD TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

      ******************************************************************
       2050-LOAD-REPORT-RECORDS.
      ******************************************************************
           IF  IN-REPORT-REC-TYPE-NUM NUMERIC
               IF  IN-REPORT-REC-TYPE-NUM =  REPORT-REC-COUNT
                   PERFORM 2060-CHECK-REC-TYPE
                   ADD 1 TO REPORT-REC-COUNT
               ELSE
                   IF  IN-REPORT-REC-TYPE-NUM =  4
                   AND REPORT-REC-COUNT  =  5
                       PERFORM 2060-CHECK-REC-TYPE
                   ELSE
                       MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                       MOVE ERRMSG-MISSING-REPORT-RECORD
                         TO FD-PRINTER-REC
                       PERFORM 9999-WRITE-PRINTER
                       PERFORM 2060-CHECK-REC-TYPE
                       COMPUTE REPORT-REC-COUNT  =
                               IN-REPORT-REC-TYPE-NUM + 1
                   END-IF
               END-IF
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-INVALID-REPORT-RECORD TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           PERFORM 2010-READ-IN-REPORT-FILE.

      /*****************************************************************
       2060-CHECK-REC-TYPE.
      ******************************************************************
           EVALUATE TRUE
               WHEN IN-REPORT-REC-TYPE-NUM = 2
                    MOVE IN-REPORT-RUP1-TYPE TO RDF-RUP1-TYPE
                    MOVE IN-REPORT-RUP1-MNEMONICS TO RDF-RUP1-MNEMONICS
               WHEN IN-REPORT-REC-TYPE-NUM = 3
                    MOVE IN-REPORT-RUP2-TYPE TO RDF-RUP2-TYPE
                    MOVE IN-REPORT-RUP2-MNEMONICS TO RDF-RUP2-MNEMONICS
               WHEN IN-REPORT-REC-TYPE-NUM = 4
                    MOVE IN-REPORT-DOLLAR-FLAG TO RDF-DOLLAR-FLAG
                    PERFORM 2070-MOVE-PERIOD-CODES VARYING
                        REC4-INDEX FROM 1 BY 1 UNTIL
                        REC4-INDEX > MAX-PRINTABLE-COL
               WHEN IN-REPORT-REC-TYPE-NUM = 5
                    MOVE IN-REPORT-TITLE-1 TO RDF-TITLE-1
               WHEN IN-REPORT-REC-TYPE-NUM = 6
                    MOVE IN-REPORT-TITLE-2 TO RDF-TITLE-2
               WHEN IN-REPORT-REC-TYPE-NUM = 7
                    MOVE IN-REPORT-TITLE-3-1 TO RDF-TITLE-3-1
               WHEN IN-REPORT-REC-TYPE-NUM = 8
                    MOVE IN-REPORT-TITLE-3-2 TO RDF-TITLE-3-2
           END-EVALUATE.

      /*****************************************************************
       2070-MOVE-PERIOD-CODES.
      ******************************************************************
           IF  RDF-PERIOD-INDEX NOT >  MAX-COL
               MOVE IN-REPORT-PD-MNEM (REC4-INDEX) TO
                   RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX)
               ADD 1 TO RDF-PERIOD-INDEX
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-TOO-MANY-TYPE-4 TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

      /************************************************************
       3000-EDIT-ORG-TABLE.
      *************************************************************
           MOVE LOW-VALUES TO ORG-TABLE-1  ORG-FLAG-TABLE
                              ORG-TABLE-2  ORG-TABLE-3.
           MOVE HIGH-VALUES TO ORG-TOT-ENTRY-TABLE.

           OPEN INPUT  IN-ORG-FILE
                OUTPUT WORK-FILE.
           SORT SORT-FILE ON ASCENDING   SD-ORG-ID
                                         SD-ORG-MNEM
               INPUT PROCEDURE IS  3010-PREPARE-ORG-MNEM-SORT
                             THRU  3099-EXIT
               OUTPUT PROCEDURE IS 3100-CHECK-FOR-DUP-ORG-MNEM
                             THRU  3129-EXIT.
           CLOSE IN-ORG-FILE
                 WORK-FILE.
           SORT SORT-FILE ON ASCENDING   SD-ORG-ID
                                         SD-ORG-ROLLUP-KEY
               USING WORK-FILE
               OUTPUT PROCEDURE IS 3200-CHECK-FOR-DUP-ORG-KEY
                              THRU 3229-EXIT.

           PERFORM 3250-FIND-NEXT-ORG-ROLLUPS
               VARYING ORG-ID-INDEX FROM 1 BY 1
               UNTIL  ORG-ID-INDEX  >  MAX-ORG-ID.

           MOVE ZERO TO PAGE-COUNT.
           PERFORM 3300-PRINT-ORG-EDIT-REPORT
               VARYING ORG-ID-INDEX FROM 1 BY 1
               UNTIL  ORG-ID-INDEX  >  MAX-ORG-ID.

           PERFORM 3400-UPDATE-REPORT-ORG-INDEXES.
      /*****************************************************************
       3010-PREPARE-ORG-MNEM-SORT.
      ******************************************************************
           MOVE SPACES TO IN-ORG-FILE-STATUS.
           PERFORM 3020-READ-IN-ORG-FILE.
           MOVE ZERO TO ORG-ID-COUNT.
           IF  NOT END-OF-ORG-FILE
               PERFORM 3030-CHECK-ORG-IDS
                   UNTIL  END-OF-ORG-FILE
           ELSE
               DISPLAY '@@ NO RECORDS ON ORG FILE @@'
               MOVE '@@ NO RECORDS ON ORG FILE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           GO TO 3099-EXIT.
      ******************************************************************
       3020-READ-IN-ORG-FILE.
      ******************************************************************
           PERFORM 3025-READ-IN-ORG-FILE.
           PERFORM 3025-READ-IN-ORG-FILE UNTIL
               (IN-ORG-ID-1 IS NOT = '/') OR
                   END-OF-ORG-FILE.
      ******************************************************************
       3025-READ-IN-ORG-FILE.
      ******************************************************************
           READ IN-ORG-FILE  INTO  IN-ORG-REC
               AT END
                   MOVE 'EOF' TO IN-ORG-FILE-STATUS.
      ******************************************************************
       3030-CHECK-ORG-IDS.
      ******************************************************************
           IF  IN-ORG-ID IS NOT =  SAVE-ORG-ID
               MOVE IN-ORG-ID TO SAVE-ORG-ID
               PERFORM 3040-SEARCH-FOR-ORG-ID
           ELSE
               PERFORM 3050-MOVE-TO-ORG-TABLE
               PERFORM 3060-FORMAT-ORG-MNEM-SORT-REC
               PERFORM 3020-READ-IN-ORG-FILE
           END-IF.

      ******************************************************************
       3040-SEARCH-FOR-ORG-ID.
      ******************************************************************
           SET REPORT-INDEX TO 1.
           SEARCH REPORT-TABLE-ENTRIES
               AT END
                   PERFORM 3070-BYPASS-ORG-ID
               WHEN RDT-ORG-ID (REPORT-INDEX)  =  IN-ORG-ID
                   ADD 1 TO ORG-ID-COUNT
                   MOVE ORG-ID-COUNT TO ORG-ID-INDEX
                   MOVE MAX-ORG-LVLS TO LOW-ORG-LEVEL
                   MOVE 1 TO ORG-ENTRY-COUNT
                   MOVE ORG-ENTRY-COUNT TO ORG-ENTRY-INDEX
                   MOVE IN-ORG-REC TO ORG-HEADER-WORK-AREA
                   MOVE IN-ORG-HEADER-RECORD-1 TO ORG-TABLE-ENTRY-1
                              (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                   MOVE IN-ORG-HEADER-RECORD-2 TO ORG-TABLE-ENTRY-2
                              (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                   MOVE IN-ORG-HEADER-RECORD-3 TO ORG-TABLE-ENTRY-3
                              (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                   MOVE IN-ORG-REC TO SAVE-ORG-HEADER (ORG-ID-COUNT)
                   PERFORM 3020-READ-IN-ORG-FILE.

           IF  ORG-ID-COUNT >  MAX-ORG-ID
               DISPLAY '@@ ERROR - MORE THAN 4 ORG TABLES @@'
               DISPLAY '@@  INCREASE ORG TABLE SIZE   @@'
               MOVE '@@ ERROR - MORE THAN 4 ORG TABLES @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE ORG TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

      /*****************************************************************
       3050-MOVE-TO-ORG-TABLE.
      ******************************************************************
           ADD 1 TO ORG-ENTRY-COUNT.
           IF  ORG-ENTRY-COUNT >  MAX-ORG
               DISPLAY '@@ ERROR - ORG ENTRIES OVER 5000 @@'
               DISPLAY '@@  INCREASE ORG TABLE SIZE   @@'
               MOVE '@@ ERROR - ORG ENTRIES OVER 5000 @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE ORG TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

           MOVE ORG-ENTRY-COUNT TO ORG-ENTRY-INDEX.
           MOVE IN-ORG-ID TO
                ORG-TBL-ID (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-KEY-LITERAL (1) TO ORG-KEY-WORK (1).
           MOVE IN-ORG-KEY-LITERAL (2) TO ORG-KEY-WORK (2).
           MOVE IN-ORG-KEY-LITERAL (3) TO ORG-KEY-WORK (3).
           MOVE IN-ORG-KEY-LITERAL (4) TO ORG-KEY-WORK (4).
           MOVE IN-ORG-KEY-LITERAL (5) TO ORG-KEY-WORK (5).
           MOVE IN-ORG-KEY-LITERAL (6) TO ORG-KEY-WORK (6).
           MOVE IN-ORG-KEY-LITERAL (7) TO ORG-KEY-WORK (7).
           MOVE IN-ORG-KEY-LITERAL (8) TO ORG-KEY-WORK (8).
           MOVE IN-ORG-KEY-LITERAL (9) TO ORG-KEY-WORK (9).
           MOVE IN-ORG-KEY-LITERAL (10) TO ORG-KEY-WORK (10).
           MOVE IN-ORG-KEY-LITERAL (11) TO ORG-KEY-WORK (11).
           MOVE ORG-KEY-WORK-AREA TO
                ORG-TBL-ROLLUP-KEY (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-SEARCH-KEY-1 TO
                ORG-TBL-SEARCH-KEY-1 (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-SEARCH-KEY-2 TO
                ORG-TBL-SEARCH-KEY-2 (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-SEARCH-KEY-3 TO
                ORG-TBL-SEARCH-KEY-3 (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-ENTRY-DESC TO
                ORG-TBL-DESC (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-ENTRY-MNEM TO
                ORG-TBL-ENTRY-MNEM (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE SPACE TO ORG-TBL-USAGE-FLAG
                     (ORG-ID-INDEX, ORG-ENTRY-INDEX).
           MOVE IN-ORG-PRINT-SUPP-FLAG TO ORG-TBL-PRINT-SUPP-FLAG
                     (ORG-ID-COUNT, ORG-ENTRY-COUNT).
           PERFORM 3053-FIND-ORG-LEVELS.
      /*************************************************************
       3053-FIND-ORG-LEVELS.
      **************************************************************
           MOVE 11 TO ORG-WORK-SUB.
           PERFORM 3055-CHECK-ORG-LEVELS  11  TIMES.
           IF  IN-ORG-ROLLUP-KEY =  SPACES
               MOVE ORG-ID-INDEX TO ORG-FLAG-ID-INDEX
               MOVE ORG-ENTRY-INDEX TO ORG-FLAG-INDEX
               MOVE 'Y' TO ORG-TBL-LEVEL-FLAG
                   (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)
           ELSE
               PERFORM VARYING ORG-WORK-SUB FROM 11 BY -1
                  UNTIL IN-ORG-KEY-LITERAL (ORG-WORK-SUB) NOT = SPACES
               END-PERFORM

               MOVE ORG-WORK-SUB TO ORG-TBL-KEY-LEVEL
                    (ORG-ID-INDEX, ORG-ENTRY-INDEX)

               IF  ORG-WORK-SUB <  LOW-ORG-LEVEL
                   MOVE ORG-WORK-SUB TO LOW-ORG-LEVEL
                   MOVE ORG-ENTRY-INDEX
                       TO ORG-TOT-ENTRY (ORG-ID-COUNT)
               END-IF
           END-IF.

           IF  IN-ORG-ROLLUP-KEY NOT =  SPACES
               PERFORM VARYING ORG-WORK-SUB FROM 1 BY 1
                   UNTIL IN-ORG-KEY-LITERAL (ORG-WORK-SUB) NOT = SPACES
               END-PERFORM

               MOVE ORG-WORK-SUB TO ORG-TBL-KEY-HI-LEVEL
                    (ORG-ID-INDEX, ORG-ENTRY-INDEX)
           END-IF.

      ******************************************************************
       3055-CHECK-ORG-LEVELS.
      ******************************************************************
           IF  ORG-HDR-LEVEL (ORG-WORK-SUB)  =  SPACES
               IF  IN-ORG-KEY-LITERAL (ORG-WORK-SUB)  NOT =  SPACES
                   MOVE ORG-ID-INDEX TO ORG-FLAG-ID-INDEX
                   MOVE ORG-ENTRY-INDEX TO ORG-FLAG-INDEX
                   MOVE 'Y' TO ORG-TBL-LEVEL-FLAG
                       (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)
               END-IF
           END-IF.

           SUBTRACT 1 FROM ORG-WORK-SUB.

      /*****************************************************************
       3060-FORMAT-ORG-MNEM-SORT-REC.
      ******************************************************************
           MOVE ORG-ENTRY-COUNT TO SD-ORG-ENTRY-COUNT.
           MOVE ORG-ID-COUNT TO SD-ORG-ID-INDEX.
           MOVE ORG-ENTRY-COUNT TO ORG-COUNT (ORG-ID-COUNT).
           MOVE IN-ORG-ID TO SD-ORG-ID.
           MOVE IN-ORG-ENTRY-MNEM TO SD-ORG-MNEM.
           MOVE ORG-KEY-WORK-AREA TO SD-ORG-ROLLUP-KEY.
           RELEASE SD-ORG-REC.
      ******************************************************************
       3070-BYPASS-ORG-ID.
      ******************************************************************
           MOVE IN-ORG-ID TO CHECK-ORG-ID.
           PERFORM 3020-READ-IN-ORG-FILE
               UNTIL  IN-ORG-ID  IS NOT =  CHECK-ORG-ID
                  OR  END-OF-ORG-FILE.
      ******************************************************************
       3099-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       3100-CHECK-FOR-DUP-ORG-MNEM.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS
                          SAVE-ORG-ID
                          SAVE-ORG-MNEM.
           MOVE HIGH-VALUES TO ORG-MNEMONIC-TABLE.
           SET ORG-M-INDEX TO 1.
           PERFORM 3110-RETURN-ORG-MNEM-REC.
           PERFORM 3120-COMPARE-ORG-MNEMS
               UNTIL  END-OF-SORT-FILE.
           GO TO 3129-EXIT.
      ******************************************************************
       3110-RETURN-ORG-MNEM-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       3120-COMPARE-ORG-MNEMS.
      ******************************************************************
           IF  SD-ORG-MNEM IS NOT =  SPACES
               MOVE SD-ORG-MNEM TO
                   ORG-MNEMONIC-KEY-VALUE (ORG-M-INDEX)
               MOVE SD-ORG-ID-INDEX
                   TO ORG-MNEMONIC-KEY-ID (ORG-M-INDEX)
               MOVE SD-ORG-ENTRY-COUNT
                   TO ORG-MNEMONIC-ENTRY-INDEX (ORG-M-INDEX)
               SET ORG-M-INDEX UP BY 1
               IF  SD-ORG-MNEM =  SAVE-ORG-MNEM
                   MOVE 'Y' TO ORG-TBL-MNEM-FLAG
                       (SD-ORG-ID-INDEX, SD-ORG-ENTRY-COUNT)
               END-IF
           END-IF.

           MOVE SD-ORG-MNEM TO SAVE-ORG-MNEM.
           WRITE FD-WORK-REC  FROM  SD-ORG-REC.
           PERFORM 3110-RETURN-ORG-MNEM-REC.
      ******************************************************************
       3129-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       3200-CHECK-FOR-DUP-ORG-KEY.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS
                          SAVE-ORG-ID
                          SAVE-ORG-ROLLUP-KEY.
           PERFORM 3210-RETURN-ORG-KEY-REC.
           PERFORM 3220-COMPARE-ORG-KEYS
               UNTIL  END-OF-SORT-FILE.
           GO TO 3229-EXIT.
      ******************************************************************
       3210-RETURN-ORG-KEY-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       3220-COMPARE-ORG-KEYS.
      ******************************************************************
           IF  SD-ORG-ID IS NOT =  SAVE-ORG-ID
               MOVE SD-ORG-ID TO SAVE-ORG-ID
               MOVE SD-ORG-ROLLUP-KEY TO SAVE-ORG-ROLLUP-KEY
           ELSE
               IF  SD-ORG-ROLLUP-KEY =  SAVE-ORG-ROLLUP-KEY
                   MOVE 'Y' TO ORG-TBL-KEY-FLAG
                       (SD-ORG-ID-INDEX, SD-ORG-ENTRY-COUNT)
               ELSE
                   MOVE SD-ORG-ROLLUP-KEY TO SAVE-ORG-ROLLUP-KEY
               END-IF
           END-IF.

           PERFORM 3210-RETURN-ORG-KEY-REC.
      ******************************************************************
       3229-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       3250-FIND-NEXT-ORG-ROLLUPS.
      ******************************************************************
           PERFORM 3260-SEARCH-FOR-ORG-ROLLUP
               VARYING ORG-ENTRY-INDEX FROM 2 BY 1
               UNTIL ORG-ENTRY-INDEX  >  MAX-ORG
               OR ORG-TABLE-ENTRY-1 (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                   =  LOW-VALUES.
      ******************************************************************
       3260-SEARCH-FOR-ORG-ROLLUP.
      ******************************************************************
           MOVE ORG-TBL-ROLLUP-KEY (ORG-ID-INDEX, ORG-ENTRY-INDEX)
               TO ORG-KEY-WORK-AREA.
           MOVE ORG-TBL-KEY-LEVEL (ORG-ID-INDEX, ORG-ENTRY-INDEX)
               TO  ORG-WORK-SUB.
           MOVE SPACES TO ORG-KEY-WORK (ORG-WORK-SUB).

           IF  ORG-KEY-WORK-AREA NOT =  SPACES
               PERFORM 3270-SEARCH-ORG-TABLE
           END-IF.

      ******************************************************************
       3270-SEARCH-ORG-TABLE.
      ******************************************************************
           PERFORM VARYING ORG-ROLLUP-INDEX FROM 2 BY 1
               UNTIL ORG-ROLLUP-INDEX  >  MAX-ORG
                  OR ORG-TBL-ROLLUP-KEY
                       (ORG-ID-INDEX, ORG-ROLLUP-INDEX)
                          =  ORG-KEY-WORK-AREA
           END-PERFORM.

           IF  ORG-ROLLUP-INDEX  >  MAX-ORG
               MOVE ORG-ID-INDEX TO ORG-FLAG-ID-INDEX
               MOVE ORG-ENTRY-INDEX TO ORG-FLAG-INDEX
               MOVE 'Y' TO ORG-TBL-ROLLUP-FLAG
                   (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)
           ELSE
               MOVE ORG-ROLLUP-INDEX
                   TO ORG-TBL-NEXT-TOT
                         (ORG-ID-INDEX, ORG-ENTRY-INDEX)
           END-IF.

      /*****************************************************************
       3300-PRINT-ORG-EDIT-REPORT.
      ******************************************************************
           MOVE 99 TO LINE-COUNT.
           PERFORM 3310-PRINT-ORG-DETAIL
               VARYING ORG-ENTRY-INDEX FROM 2 BY 1
                 UNTIL ORG-ENTRY-INDEX  >  MAX-ORG
                 OR ORG-TABLE-ENTRY-1 (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                    =  LOW-VALUES.
      /*****************************************************************
       3310-PRINT-ORG-DETAIL.
      ******************************************************************
           MOVE SPACES TO ORG-DETAIL-LINE.
           IF  LINE-COUNT >  59
               PERFORM 3320-PRINT-ORG-HEADING
           END-IF.
           MOVE ORG-ENTRY-INDEX TO WORK-INDEX.
           MOVE WORK-INDEX TO D-ORG-ENTRY-INDEX.
           MOVE ORG-TBL-ROLLUP-KEY (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO ORG-KEY-WORK-AREA.
           MOVE ORG-KEY-WORK (1) TO D-ORG-ROLLUP-LEVEL (1).
           MOVE ORG-KEY-WORK (2) TO D-ORG-ROLLUP-LEVEL (2).
           MOVE ORG-KEY-WORK (3) TO D-ORG-ROLLUP-LEVEL (3).
           MOVE ORG-KEY-WORK (4) TO D-ORG-ROLLUP-LEVEL (4).
           MOVE ORG-KEY-WORK (5) TO D-ORG-ROLLUP-LEVEL (5).
           MOVE ORG-KEY-WORK (6) TO D-ORG-ROLLUP-LEVEL (6).
           MOVE ORG-KEY-WORK (7) TO D-ORG-ROLLUP-LEVEL (7).
           MOVE ORG-KEY-WORK (8) TO D-ORG-ROLLUP-LEVEL (8).
           MOVE ORG-KEY-WORK (9) TO D-ORG-ROLLUP-LEVEL (9).
           MOVE ORG-KEY-WORK (10) TO D-ORG-ROLLUP-LEVEL (10).
           MOVE ORG-KEY-WORK (11) TO D-ORG-ROLLUP-LEVEL (11).
           MOVE ORG-TBL-SEARCH-KEY-1 (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO D-ORG-SEARCH-KEY-1.
           MOVE ORG-TBL-SEARCH-KEY-2 (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO D-ORG-SEARCH-KEY-2.
           MOVE ORG-TBL-SEARCH-KEY-3 (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO D-ORG-SEARCH-KEY-3.
           MOVE ORG-TBL-DESC (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO D-ORG-DESC.
           MOVE ORG-TBL-ENTRY-MNEM (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO D-ORG-MNEM.
           MOVE ORG-ID-INDEX TO ORG-FLAG-ID-INDEX.
           MOVE ORG-ENTRY-INDEX TO ORG-FLAG-INDEX.
           MOVE ORG-TBL-PRINT-SUPP-FLAG
                     (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)
                TO D-ORG-SUPP-FLAG.

           MOVE ' ORG TABLE'     TO W0003-LINE-TYPE-DESC
           MOVE ORG-DETAIL-LINE  TO W0003-DETAIL-DATA

           WRITE FD-PRINTER-REC  FROM  ORG-DETAIL-LINE
               AFTER ADVANCING 1 LINES.

           ADD 1 TO LINE-COUNT.
           MOVE SPACES TO ORG-DETAIL-LINE.

           IF  ORG-TBL-MNEM-FLAG
                 (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-DUP-ORG-MNEM TO D-ORG-ERROR-MSG
               MOVE ORG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  ORG-TBL-LEVEL-FLAG
                 (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-ORG-LEVEL TO D-ORG-ERROR-MSG
               MOVE ORG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  ORG-TBL-KEY-FLAG
                 (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-DUP-ORG-KEY TO D-ORG-ERROR-MSG
               MOVE ORG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  ORG-TBL-ROLLUP-FLAG
                 (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-ORG-ROLLUP TO D-ORG-ERROR-MSG
               MOVE ORG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

      /*****************************************************************
       3320-PRINT-ORG-HEADING.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE ORG-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           MOVE ORG-TABLE-ENTRY-1 (ORG-ID-INDEX, 1)
                  TO IN-ORG-HEADER-RECORD-1.
           MOVE ORG-TABLE-ENTRY-2 (ORG-ID-INDEX, 1)
                  TO IN-ORG-HEADER-RECORD-2.
           MOVE ORG-TABLE-ENTRY-3 (ORG-ID-INDEX, 1)
                  TO IN-ORG-HEADER-RECORD-3.
           MOVE IN-ORG-ID TO H-ORG-ID.
           IF  IN-ORG-DEFAULT-FAM NOT =  SPACES
               MOVE '** DEFAULT FAMILY = ' TO H-ORG-FAM-MSG
               MOVE IN-ORG-DEFAULT-FAM TO H-ORG-DEFAULT-FAM
           END-IF.

           WRITE FD-PRINTER-REC  FROM  ORG-HEADING-1
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO H-ORG-FAM-AREA.
           MOVE IN-ORG-TABLE-DESC TO H-ORG-DESC.
           WRITE FD-PRINTER-REC  FROM  ORG-HEADING-2
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  ORG-HEADING-3
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  ORG-HEADING-4
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO H-ORG-LEVELS.
           MOVE IN-ORG-LEVEL-MNEM (1) TO H-ORG-LEVEL (1).
           MOVE IN-ORG-LEVEL-MNEM (2) TO H-ORG-LEVEL (2).
           MOVE IN-ORG-LEVEL-MNEM (3) TO H-ORG-LEVEL (3).
           MOVE IN-ORG-LEVEL-MNEM (4) TO H-ORG-LEVEL (4).
           MOVE IN-ORG-LEVEL-MNEM (5) TO H-ORG-LEVEL (5).
           MOVE IN-ORG-LEVEL-MNEM (6) TO H-ORG-LEVEL (6).
           MOVE IN-ORG-LEVEL-MNEM (7) TO H-ORG-LEVEL (7).
           MOVE IN-ORG-LEVEL-MNEM (8) TO H-ORG-LEVEL (8).
           MOVE IN-ORG-LEVEL-MNEM (9) TO H-ORG-LEVEL (9).
           MOVE IN-ORG-LEVEL-MNEM (10) TO H-ORG-LEVEL (10).
           MOVE IN-ORG-LEVEL-MNEM (11) TO H-ORG-LEVEL (11).
           WRITE FD-PRINTER-REC  FROM  ORG-HEADING-5
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE 12 TO LINE-COUNT.
      /*****************************************************************
       3400-UPDATE-REPORT-ORG-INDEXES.
      ******************************************************************
           PERFORM 3410-CHECK-REPORT-ORG-ID
               VARYING REPORT-INDEX FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                             =    HIGH-VALUES.
      ******************************************************************
       3410-CHECK-REPORT-ORG-ID.
      ******************************************************************
           MOVE ZERO TO RDT-ORG-ID-INDEX (REPORT-INDEX).
           IF  RDT-ORG-ID (REPORT-INDEX) =  ORG-TBL-ID (1, 1)
               MOVE 1 TO RDT-ORG-ID-INDEX (REPORT-INDEX)
               MOVE ORG-TOT-ENTRY (1) TO
                    RDT-ORG-TOT-ENTRY (REPORT-INDEX)
           ELSE
           IF  RDT-ORG-ID (REPORT-INDEX) =  ORG-TBL-ID (2, 1)
               MOVE 2 TO RDT-ORG-ID-INDEX (REPORT-INDEX)
               MOVE ORG-TOT-ENTRY (2) TO
                    RDT-ORG-TOT-ENTRY (REPORT-INDEX)
           ELSE
           IF  RDT-ORG-ID (REPORT-INDEX) =  ORG-TBL-ID (3, 1)
               MOVE 3 TO RDT-ORG-ID-INDEX (REPORT-INDEX)
               MOVE ORG-TOT-ENTRY (3) TO
                    RDT-ORG-TOT-ENTRY (REPORT-INDEX)
           ELSE
           IF  RDT-ORG-ID (REPORT-INDEX) =  ORG-TBL-ID (4, 1)
               MOVE 4 TO RDT-ORG-ID-INDEX (REPORT-INDEX)
               MOVE ORG-TOT-ENTRY (4) TO
                    RDT-ORG-TOT-ENTRY (REPORT-INDEX)
           END-IF.

      /*****************************************************************
       4000-EDIT-REG-TABLE.
      ******************************************************************

           MOVE LOW-VALUES TO REG-TABLE    REG-FLAG-TABLE
                              REG-HDR-FLAG-TABLE.
           MOVE HIGH-VALUES TO REG-TOT-ENTRY-TABLE.

           OPEN INPUT  IN-REG-FILE
                OUTPUT WORK-FILE.
           SORT SORT-FILE ON ASCENDING   SD-REG-ID
                                         SD-REG-MNEM
               INPUT PROCEDURE IS  4010-PREPARE-REG-MNEM-SORT
                             THRU  4079-EXIT
               OUTPUT PROCEDURE IS 4100-CHECK-FOR-DUP-REG-MNEM
                             THRU  4129-EXIT.
           CLOSE IN-REG-FILE
                 WORK-FILE.
           OPEN OUTPUT WORK-FILE-2.
           SORT SORT-FILE ON ASCENDING   SD-REG-ID
                                         SD-REG-SEARCH-KEY
               USING WORK-FILE
               OUTPUT PROCEDURE IS 4150-CHECK-DUP-REG-SEARCH-KEY
                              THRU 4189-EXIT.
           CLOSE WORK-FILE-2.
           SORT SORT-FILE ON ASCENDING   SD-REG-ID
                                         SD-REG-ROLLUP-KEY
               USING WORK-FILE-2
               OUTPUT PROCEDURE IS 4200-CHECK-FOR-DUP-REG-KEY
                              THRU 4229-EXIT.

           PERFORM 4250-FIND-NEXT-REG-ROLLUPS
               VARYING REG-ID-INDEX FROM 1 BY 1
               UNTIL  REG-ID-INDEX  >  MAX-REG-ID.

           MOVE ZERO TO PAGE-COUNT.
           PERFORM 4300-PRINT-REG-EDIT-REPORT
               VARYING REG-ID-INDEX FROM 1 BY 1
               UNTIL  REG-ID-INDEX  >  MAX-REG-ID.

           PERFORM 4400-UPDATE-REPORT-REG-INDEXES.
      /*****************************************************************
       4010-PREPARE-REG-MNEM-SORT.
      ******************************************************************
           MOVE SPACES TO IN-REG-FILE-STATUS.
           PERFORM 4020-READ-IN-REG-FILE.
           MOVE ZERO TO REG-ID-COUNT.
           IF  NOT END-OF-REG-FILE
               PERFORM 4030-CHECK-REG-IDS
                   UNTIL  END-OF-REG-FILE
           ELSE
               DISPLAY '@@ NO RECORDS ON REG FILE @@'
               MOVE '@@ NO RECORDS ON REG FILE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           GO TO 4079-EXIT.
      ******************************************************************
       4020-READ-IN-REG-FILE.
      ******************************************************************
           PERFORM 4025-READ-IN-REG-FILE.
           PERFORM 4025-READ-IN-REG-FILE UNTIL
               (IN-REG-ID-1 IS NOT = '/') OR
                   END-OF-REG-FILE.
      ******************************************************************
       4025-READ-IN-REG-FILE.
      ******************************************************************
           READ IN-REG-FILE  INTO  IN-REG-REC
               AT END
                   MOVE 'EOF' TO IN-REG-FILE-STATUS.
      ******************************************************************
       4030-CHECK-REG-IDS.
      ******************************************************************
           IF  IN-REG-ID IS NOT =  SAVE-REG-ID
               MOVE IN-REG-ID TO SAVE-REG-ID
               PERFORM 4040-SEARCH-FOR-REG-ID
           ELSE
               PERFORM 4050-MOVE-TO-REG-TABLE
               PERFORM 4060-FORMAT-REG-MNEM-SORT-REC
               PERFORM 4020-READ-IN-REG-FILE
           END-IF.

      ******************************************************************
       4040-SEARCH-FOR-REG-ID.
      ******************************************************************
           SET REPORT-INDEX TO 1.
           SEARCH REPORT-TABLE-ENTRIES
               AT END
                   PERFORM 4070-BYPASS-REG-ID
               WHEN RDT-REG-ID (REPORT-INDEX)  =  IN-REG-ID
                   ADD 1 TO REG-ID-COUNT
                   SET REG-ID-INDEX TO REG-ID-COUNT
                   MOVE MAX-REG-LVLS TO LOW-REG-LEVEL
                   MOVE 1 TO REG-ENTRY-COUNT
                   SET REG-ENTRY-INDEX TO REG-ENTRY-COUNT
                   MOVE IN-REG-REC TO REG-HEADER-WORK-AREA
                   MOVE IN-REG-REC TO REG-TABLE-ENTRY
                              (REG-ID-INDEX, REG-ENTRY-INDEX)
                   MOVE IN-REG-REC TO SAVE-REG-HEADER (REG-ID-COUNT)
                   PERFORM 4065-FORMAT-REG-HDR-SORT-REC
                   PERFORM 4020-READ-IN-REG-FILE.

           IF  REG-ID-COUNT >  MAX-REG-ID
               DISPLAY '@@ ERROR - MORE THAN 10 REG TABLES @@'
               DISPLAY '@@  INCREASE REG TABLE SIZE   @@'
               MOVE '@@ ERROR - MORE THAN 10 REG TABLES @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE REG TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

      /*****************************************************************
       4050-MOVE-TO-REG-TABLE.
      ******************************************************************
           ADD 1 TO REG-ENTRY-COUNT.
           SET REG-ENTRY-INDEX TO REG-ENTRY-COUNT.
           MOVE IN-REG-ID TO
                REG-TBL-ID (REG-ID-INDEX, REG-ENTRY-INDEX).
           MOVE IN-REG-KEY-LITERAL (1) TO REG-KEY-WORK (1).
           MOVE IN-REG-KEY-LITERAL (2) TO REG-KEY-WORK (2).
           MOVE IN-REG-KEY-LITERAL (3) TO REG-KEY-WORK (3).
           MOVE IN-REG-KEY-LITERAL (4) TO REG-KEY-WORK (4).
           MOVE IN-REG-KEY-LITERAL (5) TO REG-KEY-WORK (5).
           MOVE IN-REG-KEY-LITERAL (6) TO REG-KEY-WORK (6).
           MOVE IN-REG-KEY-LITERAL (7) TO REG-KEY-WORK (7).
           MOVE IN-REG-KEY-LITERAL (8) TO REG-KEY-WORK (8).
           MOVE REG-KEY-WORK-AREA TO
                REG-TBL-ROLLUP-KEY (REG-ID-INDEX, REG-ENTRY-INDEX).
           MOVE IN-REG-SEARCH-KEY TO
                REG-TBL-SEARCH-KEY (REG-ID-INDEX, REG-ENTRY-INDEX).
           MOVE IN-REG-ENTRY-DESC TO
                REG-TBL-DESC (REG-ID-INDEX, REG-ENTRY-INDEX).
           MOVE IN-REG-ENTRY-MNEM TO
                REG-TBL-ENTRY-MNEM (REG-ID-INDEX, REG-ENTRY-INDEX).

           IF  IN-REG-LOC NOT =  SPACES
               IF  IN-REG-DIV NOT =  SPACES
                   MOVE 'Y' TO REG-HDR-LOC-DIV-FLAG (REG-ID-COUNT)
               ELSE
                   MOVE 'Y' TO REG-HDR-LOC-FLAG (REG-ID-COUNT)
               END-IF
           END-IF.

           IF  IN-REG-DIV NOT =  SPACES
               IF  IN-REG-FAM NOT =  SPACES
                   MOVE 'Y' TO REG-HDR-DIV-FAM-FLAG (REG-ID-COUNT)
               ELSE
               IF  IN-REG-LOC =  SPACES
                   MOVE 'Y' TO REG-HDR-DIV-FLAG (REG-ID-COUNT)
               END-IF
           END-IF.

           MOVE SPACE TO REG-TBL-USAGE-FLAG
                   (REG-ID-INDEX, REG-ENTRY-INDEX).
           PERFORM 4053-FIND-REG-LEVELS.
      /************************************************************
       4053-FIND-REG-LEVELS.
      *************************************************************
           MOVE 8 TO REG-WORK-SUB.
           PERFORM 4055-CHECK-REG-LEVELS  8  TIMES.
           IF  IN-REG-ROLLUP-KEY =  SPACES
               SET REG-FLAG-ID-INDEX TO REG-ID-INDEX
               SET REG-FLAG-INDEX TO REG-ENTRY-INDEX
               MOVE 'Y' TO REG-TBL-LEVEL-FLAG
                   (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)
           ELSE
               PERFORM VARYING REG-WORK-SUB FROM 8 BY -1
                   UNTIL  IN-REG-KEY-LITERAL (REG-WORK-SUB)
                          NOT = SPACES
               END-PERFORM
               MOVE REG-WORK-SUB TO REG-TBL-KEY-LEVEL
                      (REG-ID-INDEX, REG-ENTRY-INDEX)
               IF  REG-WORK-SUB  <  LOW-REG-LEVEL
                   MOVE REG-WORK-SUB TO LOW-REG-LEVEL
                   SET REG-TOT-ENTRY (REG-ID-COUNT)
                         TO REG-ENTRY-INDEX
               END-IF
           END-IF.

           IF  IN-REG-ROLLUP-KEY  NOT =  SPACES
               PERFORM VARYING REG-WORK-SUB FROM 1 BY 1
                   UNTIL  IN-REG-KEY-LITERAL (REG-WORK-SUB)
                          NOT = SPACES
               END-PERFORM
               MOVE REG-WORK-SUB TO REG-TBL-KEY-HI-LEVEL
                    (REG-ID-INDEX, REG-ENTRY-INDEX)
           END-IF.

      ******************************************************************
       4055-CHECK-REG-LEVELS.
      ******************************************************************
           IF  REG-HDR-LEVEL (REG-WORK-SUB)  =  SPACES
               IF  IN-REG-KEY-LITERAL (REG-WORK-SUB)  NOT =  SPACES
                   SET REG-FLAG-ID-INDEX TO REG-ID-INDEX
                   SET REG-FLAG-INDEX TO REG-ENTRY-INDEX
                   MOVE 'Y' TO REG-TBL-LEVEL-FLAG
                       (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)
               END-IF
           END-IF.

           SUBTRACT 1 FROM REG-WORK-SUB.
      ******************************************************************

      /*****************************************************************
       4060-FORMAT-REG-MNEM-SORT-REC.
      ******************************************************************
           MOVE REG-ENTRY-COUNT TO SD-REG-ENTRY-COUNT.
           MOVE REG-ID-COUNT TO SD-REG-ID-INDEX.
           MOVE REG-ENTRY-COUNT TO REG-COUNT (REG-ID-COUNT).
           MOVE IN-REG-ID TO SD-REG-ID.
           MOVE IN-REG-ENTRY-MNEM TO SD-REG-MNEM.
           MOVE IN-REG-SEARCH-KEY TO SD-REG-SEARCH-KEY.
           MOVE REG-KEY-WORK-AREA TO SD-REG-ROLLUP-KEY.
           RELEASE SD-REG-REC.
      ******************************************************************
       4065-FORMAT-REG-HDR-SORT-REC.
      ******************************************************************
           MOVE SPACES TO SD-REG-REC.
           MOVE REG-ENTRY-COUNT TO SD-REG-ENTRY-COUNT.
           MOVE REG-ID-COUNT TO SD-REG-ID-INDEX.
           MOVE IN-REG-ID TO SD-REG-ID.
           RELEASE SD-REG-REC.
      ******************************************************************
       4070-BYPASS-REG-ID.
      ******************************************************************
           MOVE IN-REG-ID TO CHECK-REG-ID.
           PERFORM 4020-READ-IN-REG-FILE
               UNTIL  IN-REG-ID  IS NOT =  CHECK-REG-ID
                  OR  END-OF-REG-FILE.
      ******************************************************************
       4079-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       4100-CHECK-FOR-DUP-REG-MNEM.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS
                          SAVE-REG-ID.
           MOVE HIGH-VALUES TO REG-MNEMONIC-TABLE.
           SET REG-M-INDEX TO 1.
           MOVE LOW-VALUES TO SAVE-REG-MNEM.
           PERFORM 4110-RETURN-REG-MNEM-REC.
           PERFORM 4120-COMPARE-REG-MNEMS
               UNTIL  END-OF-SORT-FILE.
           GO TO 4129-EXIT.
      ******************************************************************
       4110-RETURN-REG-MNEM-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       4120-COMPARE-REG-MNEMS.
      ******************************************************************
           IF  SD-REG-MNEM IS NOT =  SPACES
               MOVE SD-REG-MNEM TO
                   REG-MNEMONIC-KEY-VALUE (REG-M-INDEX)
               MOVE SD-REG-ID-INDEX
                   TO REG-MNEMONIC-KEY-ID (REG-M-INDEX)
               MOVE SD-REG-ENTRY-COUNT
                   TO REG-MNEMONIC-ENTRY-INDEX (REG-M-INDEX)
               SET REG-M-INDEX UP BY 1
               IF  SD-REG-MNEM =  SAVE-REG-MNEM
                   MOVE 'Y' TO REG-TBL-MNEM-FLAG
                       (SD-REG-ID-INDEX, SD-REG-ENTRY-COUNT).
           MOVE SD-REG-MNEM TO SAVE-REG-MNEM.
           WRITE FD-WORK-REC  FROM  SD-REG-REC.
           PERFORM 4110-RETURN-REG-MNEM-REC.
      ******************************************************************
       4129-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       4150-CHECK-DUP-REG-SEARCH-KEY.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS
                          SAVE-REG-ID.
           MOVE LOW-VALUES TO SAVE-REG-SEARCH-KEY.
           PERFORM 4160-RETURN-REG-SEARCH-KEY-REC.
           PERFORM 4170-COMPARE-REG-SEARCH-KEYS
               UNTIL  END-OF-SORT-FILE.
           GO TO 4189-EXIT.
      ******************************************************************
       4160-RETURN-REG-SEARCH-KEY-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       4170-COMPARE-REG-SEARCH-KEYS.
      ******************************************************************
           IF  SD-REG-ID IS NOT =  SAVE-REG-ID
               MOVE SD-REG-ID TO SAVE-REG-ID
               MOVE SD-REG-SEARCH-KEY TO SAVE-REG-SEARCH-KEY
           ELSE
               IF  SD-REG-SEARCH-KEY IS NOT = SPACES
                   IF  SD-REG-SEARCH-KEY =  SAVE-REG-SEARCH-KEY
                       MOVE 'Y' TO REG-TBL-SEARCH-KEY-FLAG
                           (SD-REG-ID-INDEX, SD-REG-ENTRY-COUNT)
                   ELSE
                       MOVE SD-REG-SEARCH-KEY TO SAVE-REG-SEARCH-KEY
                   END-IF
               END-IF
           END-IF.

           WRITE FD-WORK-FILE-2-REC FROM SD-REG-REC.
           PERFORM 4160-RETURN-REG-SEARCH-KEY-REC.
      ******************************************************************
       4189-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       4200-CHECK-FOR-DUP-REG-KEY.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS
                          SAVE-REG-ID
                          SAVE-REG-ROLLUP-KEY.
           PERFORM 4210-RETURN-REG-KEY-REC.
           PERFORM 4220-COMPARE-REG-KEYS
               UNTIL  END-OF-SORT-FILE.
           GO TO 4229-EXIT.
      ******************************************************************
       4210-RETURN-REG-KEY-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       4220-COMPARE-REG-KEYS.
      ******************************************************************
           IF  SD-REG-ID IS NOT =  SAVE-REG-ID
               MOVE SD-REG-ID TO SAVE-REG-ID
               MOVE SD-REG-ROLLUP-KEY TO SAVE-REG-ROLLUP-KEY
           ELSE
               IF  SD-REG-ROLLUP-KEY =  SAVE-REG-ROLLUP-KEY
                   MOVE 'Y' TO REG-TBL-KEY-FLAG
                       (SD-REG-ID-INDEX, SD-REG-ENTRY-COUNT)
               ELSE
                   MOVE SD-REG-ROLLUP-KEY TO SAVE-REG-ROLLUP-KEY
               END-IF
           END-IF.

           PERFORM 4210-RETURN-REG-KEY-REC.
      ******************************************************************
       4229-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       4250-FIND-NEXT-REG-ROLLUPS.
      ******************************************************************
            PERFORM 4260-SEARCH-FOR-REG-ROLLUP
                VARYING REG-ENTRY-INDEX FROM 2 BY 1
                UNTIL REG-ENTRY-INDEX  >  MAX-REG
                   OR REG-TABLE-ENTRY (REG-ID-INDEX, REG-ENTRY-INDEX)
                     =  LOW-VALUES.
      ******************************************************************
       4260-SEARCH-FOR-REG-ROLLUP.
      ******************************************************************
            MOVE REG-TBL-ROLLUP-KEY (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO REG-KEY-WORK-AREA.
            MOVE REG-TBL-KEY-LEVEL (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO  REG-WORK-SUB.
            MOVE SPACES TO REG-KEY-WORK (REG-WORK-SUB).
            IF  REG-KEY-WORK-AREA NOT =  SPACES
                PERFORM 4270-SEARCH-REG-TABLE
           END-IF.

      ******************************************************************
       4270-SEARCH-REG-TABLE.
      ******************************************************************
            PERFORM VARYING REG-ROLLUP-INDEX FROM 2 BY 1
                UNTIL REG-ROLLUP-INDEX  >  MAX-REG
                   OR REG-TBL-ROLLUP-KEY
                        (REG-ID-INDEX, REG-ROLLUP-INDEX)
                           =  REG-KEY-WORK-AREA
            END-PERFORM.

            IF  REG-ROLLUP-INDEX  >  MAX-REG
                SET REG-FLAG-ID-INDEX TO REG-ID-INDEX
                SET REG-FLAG-INDEX TO REG-ENTRY-INDEX
                MOVE 'Y' TO REG-TBL-ROLLUP-FLAG
                    (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)
            ELSE
                SET REG-TBL-NEXT-TOT
                          (REG-ID-INDEX, REG-ENTRY-INDEX)
                      TO REG-ROLLUP-INDEX
            END-IF.

      /*****************************************************************
       4300-PRINT-REG-EDIT-REPORT.
      ******************************************************************
            MOVE 99 TO LINE-COUNT.
            PERFORM 4310-PRINT-REG-DETAIL
                VARYING REG-ENTRY-INDEX FROM 2 BY 1
                UNTIL REG-ENTRY-INDEX  >  MAX-REG
                   OR REG-TABLE-ENTRY (REG-ID-INDEX, REG-ENTRY-INDEX)
                     =  LOW-VALUES.
      /*****************************************************************
       4310-PRINT-REG-DETAIL.
      ******************************************************************
           MOVE SPACES TO REG-DETAIL-LINE.
           IF  LINE-COUNT >  59
               PERFORM 4320-PRINT-REG-HEADING
           END-IF.

           SET WORK-INDEX TO REG-ENTRY-INDEX.
           MOVE WORK-INDEX TO D-REG-ENTRY-INDEX.
           MOVE REG-TBL-ROLLUP-KEY (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO REG-KEY-WORK-AREA.
           MOVE REG-KEY-WORK (1) TO D-REG-ROLLUP-LEVEL (1).
           MOVE REG-KEY-WORK (2) TO D-REG-ROLLUP-LEVEL (2).
           MOVE REG-KEY-WORK (3) TO D-REG-ROLLUP-LEVEL (3).
           MOVE REG-KEY-WORK (4) TO D-REG-ROLLUP-LEVEL (4).
           MOVE REG-KEY-WORK (5) TO D-REG-ROLLUP-LEVEL (5).
           MOVE REG-KEY-WORK (6) TO D-REG-ROLLUP-LEVEL (6).
           MOVE REG-KEY-WORK (7) TO D-REG-ROLLUP-LEVEL (7).
           MOVE REG-KEY-WORK (8) TO D-REG-ROLLUP-LEVEL (8).
           MOVE REG-TBL-SEARCH-KEY (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO D-REG-SEARCH-KEY.
           MOVE REG-TBL-DESC (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO D-REG-DESC.
           MOVE REG-TBL-ENTRY-MNEM (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO D-REG-MNEM.

           MOVE ' REGION TABLE'  TO W0003-LINE-TYPE-DESC
           MOVE REG-DETAIL-LINE  TO W0003-DETAIL-DATA

           WRITE FD-PRINTER-REC  FROM  REG-DETAIL-LINE
               AFTER ADVANCING 1 LINES.

           ADD 1 TO LINE-COUNT.
           MOVE SPACES TO REG-DETAIL-LINE.
           SET REG-FLAG-ID-INDEX TO REG-ID-INDEX.
           SET REG-FLAG-INDEX TO REG-ENTRY-INDEX.
           IF  REG-TBL-MNEM-FLAG
                 (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-DUP-REG-MNEM TO D-REG-ERROR-MSG
               MOVE REG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  REG-TBL-LEVEL-FLAG
                 (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-REG-LEVEL TO D-REG-ERROR-MSG
               MOVE REG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  REG-TBL-SEARCH-KEY-FLAG
                 (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-DUP-REG-KEY TO D-REG-ERROR-MSG
               MOVE REG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  REG-TBL-KEY-FLAG
                 (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-DUP-REG-KEY TO D-REG-ERROR-MSG
               MOVE REG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  REG-TBL-ROLLUP-FLAG
                 (REG-FLAG-ID-INDEX, REG-FLAG-INDEX)  =  'Y'
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-REG-ROLLUP TO D-REG-ERROR-MSG
               MOVE REG-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

      /*****************************************************************
       4320-PRINT-REG-HEADING.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE REG-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           MOVE REG-TABLE-ENTRY (REG-ID-INDEX, 1)
                  TO IN-REG-HEADER-RECORD.
           MOVE IN-REG-ID TO H-REG-ID.
           WRITE FD-PRINTER-REC  FROM  REG-HEADING-1
               AFTER ADVAN  NG 2 LINES.
           MOVE IN-REG-TABLE-DESC TO H-REG-DESC.
           WRITE FD-PRINTER-REC  FROM  REG-HEADING-2
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  REG-HEADING-3
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO H-REG-LEVELS.
           MOVE IN-REG-LEVEL-MNEM (1) TO H-REG-LEVEL (1).
           MOVE IN-REG-LEVEL-MNEM (2) TO H-REG-LEVEL (2).
           MOVE IN-REG-LEVEL-MNEM (3) TO H-REG-LEVEL (3).
           MOVE IN-REG-LEVEL-MNEM (4) TO H-REG-LEVEL (4).
           MOVE IN-REG-LEVEL-MNEM (5) TO H-REG-LEVEL (5).
           MOVE IN-REG-LEVEL-MNEM (6) TO H-REG-LEVEL (6).
           MOVE IN-REG-LEVEL-MNEM (7) TO H-REG-LEVEL (7).
           MOVE IN-REG-LEVEL-MNEM (8) TO H-REG-LEVEL (8).
           WRITE FD-PRINTER-REC  FROM  REG-HEADING-4
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE 12 TO LINE-COUNT.
      /*****************************************************************
       4400-UPDATE-REPORT-REG-INDEXES.
      ******************************************************************
           PERFORM 4410-CHECK-REPORT-REG-ID
               VARYING REPORT-INDEX FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                           =    HIGH-VALUES.
      ******************************************************************
       4410-CHECK-REPORT-REG-ID.
      ******************************************************************
           MOVE ZERO TO RDT-REG-ID-INDEX (REPORT-INDEX).
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (1, 1)
               MOVE 1 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (2, 1)
               MOVE 2 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (3, 1)
               MOVE 3 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (4, 1)
               MOVE 4 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (5, 1)
               MOVE 5 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (6, 1)
               MOVE 6 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (7, 1)
               MOVE 7 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (8, 1)
               MOVE 8 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (9, 1)
               MOVE 9 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           ELSE
           IF  RDT-REG-ID (REPORT-INDEX) =  REG-TBL-ID (10, 1)
               MOVE 10 TO RDT-REG-ID-INDEX (REPORT-INDEX)
           END-IF.

      /************************************************************
       5000-EDIT-PRIME-TABLE.
      ******************************************************************

           MOVE ZERO TO PRIME-COUNT.
           SORT SORT-FILE ON ASCENDING   SD-PRIME-ID
                                         SD-PRIME-INDEX
               INPUT PROCEDURE IS  5005-PREPARE-PRIME-SORT
                             THRU  5069-EXIT
               OUTPUT PROCEDURE IS 5100-LOAD-PRIME-ID-TABLE
                             THRU  5129-EXIT.
           PERFORM 5200-REPLACE-PRIME-IDS
               VARYING PRIME-SUBACCT-INDEX FROM 1 BY 1
               UNTIL PRIME-SUBACCT-ID (PRIME-SUBACCT-INDEX)
                            =   LOW-VALUES.

      ******************************************************************
       5005-PREPARE-PRIME-SORT.
      ******************************************************************
           MOVE ZERO TO PAGE-COUNT.
           MOVE 99 TO LINE-COUNT.
           MOVE LOW-VALUES TO PRIME-TABLE.
           MOVE LOW-VALUES TO PRIME-SUBACCT-TABLE.
           MOVE LOW-VALUES TO PRIME-SUBTOT-TABLE.
           OPEN INPUT  IN-PRIME-FILE.
           MOVE SPACES TO IN-PRIME-FILE-STATUS.
           PERFORM 5010-READ-IN-PRIME-FILE.
           IF  NOT END-OF-PRIME-FILE
               SET PRIME-INDEX TO 1
               SET PRIME-SUBACCT-INDEX TO 1
               PERFORM 5020-EDIT-PRIME-ENTRIES
                   UNTIL  END-OF-PRIME-FILE
           ELSE
               DISPLAY '@@ NO ENTRIES ON PRIME TABLE @@'
               MOVE '@@ NO ENTRIES ON PRIME TABLE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           CLOSE IN-PRIME-FILE.
           GO TO 5069-EXIT.
      ******************************************************************
       5010-READ-IN-PRIME-FILE.
      ******************************************************************
           PERFORM 5015-READ-IN-PRIME-FILE.
           PERFORM 5015-READ-IN-PRIME-FILE UNTIL
               (IN-PRIME-ID-1 IS NOT = '/') OR
                   END-OF-PRIME-FILE.
      ******************************************************************
       5015-READ-IN-PRIME-FILE.
      ******************************************************************
           READ IN-PRIME-FILE  INTO  IN-PRIME-REC
               AT END
                   MOVE 'EOF' TO IN-PRIME-FILE-STATUS.
      /*****************************************************************
       5020-EDIT-PRIME-ENTRIES.
      ******************************************************************
           PERFORM 5050-PRINT-PRIME-DETAIL-LINE.
           IF  IN-PRIME-ID NOT =  SPACES
               PERFORM 5035-RELEASE-PRIME-REC
               PERFORM 5025-EDIT-NEW-PRIME
           END-IF.

           IF  IN-PRIME-DIV-FLAG =  'S'
               NEXT SENTENCE
           ELSE
               PERFORM 5040-CHECK-PRIME-CALCS
                   VARYING PRIME-CALC-INDEX FROM 1 BY 1
                   UNTIL   PRIME-CALC-INDEX  >  MAX-CALCS-ON-PRIME
                      OR   IN-PRIME-OPERAND (PRIME-CALC-INDEX)
                              =  SPACES
           END-IF.

           PERFORM 5010-READ-IN-PRIME-FILE.
           IF  NOT END-OF-PRIME-FILE
               IF  IN-PRIME-ID NOT =  SPACES
                   SET PRIME-INDEX UP BY 1
               END-IF
           END-IF.

      ******************************************************************
       5025-EDIT-NEW-PRIME.
      ******************************************************************
           ADD 1 TO PRIME-COUNT.
           IF  IN-PRIME-DIV-FLAG =  'S'
               MOVE IN-PRIME-SUBACCT TO
                        PRIME-SUBACCT-ID (PRIME-SUBACCT-INDEX)
               SET PRIME-SUBACCT-PRIME-INDEX (PRIME-SUBACCT-INDEX)
                        TO PRIME-INDEX
               SET PRIME-SUBACCT-INDEX UP BY 1
           END-IF.

           MOVE IN-PRIME-ID TO PRIME-TBL-ID (PRIME-INDEX).
           MOVE IN-PRIME-B-FLAG TO PRIME-TBL-B-FLAG (PRIME-INDEX).
           IF  IN-PRIME-B-FLAG = 'A'
               MOVE ' ' TO PRIME-TBL-B-FLAG (PRIME-INDEX).
           MOVE IN-PRIME-DIV-FLAG TO
                     PRIME-TBL-DIV-FLAG (PRIME-INDEX).

           IF  IN-PRIME-FCST-LINE =  SPACES
               MOVE '00' TO IN-PRIME-FCST-LINE
           END-IF.

           IF  IN-PRIME-FCST-LINE-NUM IS NOT NUMERIC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE '00' TO IN-PRIME-FCST-LINE
               MOVE 'Y' TO MASTER-ERROR-SWITCH
               MOVE ERRMSG-NON-NUM-FCST TO D-PRIME-ERROR-MSG
               MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           MOVE IN-PRIME-FCST-LINE
                 TO PRIME-TBL-FCST-LINE (PRIME-INDEX).
           MOVE IN-PRIME-DESC TO PRIME-TBL-DESC (PRIME-INDEX).
           PERFORM 5030-CHECK-FOR-DUP-PRIME
               VARYING PRIME-CHK-INDEX FROM 1 BY 1
               UNTIL PRIME-CHK-INDEX  =  PRIME-INDEX.

           IF  IN-PRIME-DIV-FLAG =  'S'
               IF  IN-PRIME-FILLER NOT = SPACES
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE 'Y' TO MASTER-ERROR-SWITCH
                   MOVE ERRMSG-SUBACCT-CALC TO D-PRIME-ERROR-MSG
                   MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               ELSE
                   NEXT SENTENCE
               END-IF
           ELSE
               IF  IN-PRIME-CALCS NOT =  SPACES
                   ADD 1 TO PRIME-SUBTOT-INDEX
                   MOVE PRIME-SUBTOT-INDEX
                          TO PRIME-TBL-SUBTOT-INDEX (PRIME-INDEX)
                   SET PRIME-SUBTOT-TBL-INDEX (PRIME-SUBTOT-INDEX)
                          TO PRIME-INDEX
               ELSE
                   IF  IN-PRIME-ID-BYTE1 NOT NUMERIC
                       IF  IN-PRIME-B-FLAG = 'A'
                           MOVE ' ' TO IN-PRIME-B-FLAG
                       ELSE
                           MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                           MOVE 'Y' TO MASTER-ERROR-SWITCH
                           MOVE ERRMSG-PRIME-SUBTOT-ERR
                             TO D-PRIME-ERROR-MSG
                           MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
                           PERFORM 9999-WRITE-PRINTER
                       END-IF
                   END-IF
               END-IF
           END-IF.
      /*****************************************************************
       5030-CHECK-FOR-DUP-PRIME.
      ******************************************************************
           IF  IN-PRIME-ID =  PRIME-TBL-ID (PRIME-CHK-INDEX)
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE 'Y' TO MASTER-ERROR-SWITCH
               MOVE ERRMSG-DUP-PRIME-ID TO D-PRIME-ERROR-MSG
               MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
      ******************************************************************
       5035-RELEASE-PRIME-REC.
      ******************************************************************
           MOVE IN-PRIME-ID TO SD-PRIME-ID.
           SET SD-PRIME-INDEX TO PRIME-INDEX.
           RELEASE SD-PRIME-REC.
      ******************************************************************
       5040-CHECK-PRIME-CALCS.
      ******************************************************************
           IF  IN-PRIME-OPERATOR (PRIME-CALC-INDEX) =  '+'  OR  '-'
               NEXT SENTENCE
           ELSE
               MOVE 'Y' TO MASTER-ERROR-SWITCH
               MOVE ERRMSG-INVALID-OPERATOR TO D-PRIME-ERROR-MSG
               MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           SET PRIME-CHK-INDEX TO 1.
           SEARCH PRIME-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE 'Y' TO MASTER-ERROR-SWITCH
                   MOVE ERRMSG-UNDEFINED-PRIME TO D-PRIME-ERROR-MSG
                   MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               WHEN  IN-PRIME-OPERAND (PRIME-CALC-INDEX)
                     =  PRIME-TBL-ID (PRIME-CHK-INDEX)
                   PERFORM 5045-MOVE-TO-SUBTOT.
      ** IF THE PRIME ITSELF IS IN THE CALCULATION .... !!!!!
           IF  PRIME-INDEX =  PRIME-CHK-INDEX
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE 'Y' TO MASTER-ERROR-SWITCH
               MOVE ERRMSG-UNDEFINED-PRIME TO D-PRIME-ERROR-MSG
               MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

      /*****************************************************************
       5045-MOVE-TO-SUBTOT.
      ******************************************************************
           ADD 1 TO PRIME-TBL-NEXT-SUB (PRIME-CHK-INDEX).
           IF  PRIME-TBL-NEXT-SUB (PRIME-CHK-INDEX)
                       NOT >   MAX-SUBTOTAL-INDEXES
               SET PRIME-SUB-INDEX
                   TO PRIME-TBL-NEXT-SUB (PRIME-CHK-INDEX)
               MOVE PRIME-TBL-SUBTOT-INDEX (PRIME-INDEX) TO
                 PRIME-TBL-SUB (PRIME-CHK-INDEX, PRIME-SUB-INDEX)
               MOVE IN-PRIME-OPERATOR (PRIME-CALC-INDEX)
                 TO PRIME-TBL-OPR (PRIME-CHK-INDEX, PRIME-SUB-INDEX)
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE 'Y' TO MASTER-ERROR-SWITCH
               MOVE ERRMSG-OVER-MAX-SUBTOTS TO D-PRIME-ERROR-MSG
               MOVE PRIME-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

      ******************************************************************
       5050-PRINT-PRIME-DETAIL-LINE.
      ******************************************************************
           IF  LINE-COUNT >  59
               PERFORM 5060-PRINT-PRIME-HEADINGS
           END-IF.

           MOVE SPACES TO PRIME-DETAIL-LINE.

           IF  IN-PRIME-ID NOT =  SPACES
               MOVE IN-PRIME-ID TO D-PRIME-ID
               MOVE IN-PRIME-FCST-LINE TO D-PRIME-FCST-LINE
               MOVE IN-PRIME-B-FLAG TO D-PRIME-B-FLAG
               MOVE IN-PRIME-DIV-FLAG TO D-PRIME-DIV-FLAG
               MOVE IN-PRIME-DESC TO D-PRIME-DESC
               SET PRIME-WORK-INDEX TO PRIME-INDEX
               MOVE PRIME-WORK-INDEX TO D-PRIME-INDEX
           END-IF.

           IF  IN-PRIME-DIV-FLAG =  'S'
               MOVE IN-PRIME-SUBACCT TO D-PRIME-CALC-AREA
           ELSE
               MOVE IN-PRIME-OPERAND (1) TO D-PRIME-OPERAND (1)
               MOVE IN-PRIME-OPERATOR (1) TO D-PRIME-OPERATOR (1)
               MOVE IN-PRIME-OPERAND (2) TO D-PRIME-OPERAND (2)
               MOVE IN-PRIME-OPERATOR (2) TO D-PRIME-OPERATOR (2)
               MOVE IN-PRIME-OPERAND (3) TO D-PRIME-OPERAND (3)
               MOVE IN-PRIME-OPERATOR (3) TO D-PRIME-OPERATOR (3)
               MOVE IN-PRIME-OPERAND (4) TO D-PRIME-OPERAND (4)
               MOVE IN-PRIME-OPERATOR (4) TO D-PRIME-OPERATOR (4)
               MOVE IN-PRIME-OPERAND (5) TO D-PRIME-OPERAND (5)
               MOVE IN-PRIME-OPERATOR (5) TO D-PRIME-OPERATOR (5)
               MOVE IN-PRIME-OPERAND (6) TO D-PRIME-OPERAND (6)
               MOVE IN-PRIME-OPERATOR (6) TO D-PRIME-OPERATOR (6)
               MOVE IN-PRIME-OPERAND (7) TO D-PRIME-OPERAND (7)
               MOVE IN-PRIME-OPERATOR (7) TO D-PRIME-OPERATOR (7)
               MOVE IN-PRIME-OPERAND (8) TO D-PRIME-OPERAND (8)
               MOVE IN-PRIME-OPERATOR (8) TO D-PRIME-OPERATOR (8)
           END-IF.

           MOVE ' PRIME TABLE'     TO W0003-LINE-TYPE-DESC
           MOVE PRIME-DETAIL-LINE  TO W0003-DETAIL-DATA

           WRITE FD-PRINTER-REC  FROM  PRIME-DETAIL-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO PRIME-DETAIL-LINE.
           ADD 1 TO LINE-COUNT.
      /*****************************************************************
       5060-PRINT-PRIME-HEADINGS.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE PRIME-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  PRIME-HEADING-1
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  PRIME-HEADING-2
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE 8 TO LINE-COUNT.
      ******************************************************************
       5069-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       5100-LOAD-PRIME-ID-TABLE.
      ******************************************************************
           MOVE SPACES TO SORT-FILE-STATUS.
           MOVE HIGH-VALUES TO PRIME-ID-TABLE.
           PERFORM 5110-RETURN-PRIME-REC.
           PERFORM 5120-MOVE-TO-PRIME-ID-TABLE
               VARYING PRIME-SRT-INDEX FROM 1 BY 1
               UNTIL  END-OF-SORT-FILE.
           GO TO 5129-EXIT.
      ******************************************************************
       5110-RETURN-PRIME-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       5120-MOVE-TO-PRIME-ID-TABLE.
      ******************************************************************
           MOVE SD-PRIME-ID TO PRIME-SRT-ID (PRIME-SRT-INDEX).
           MOVE SD-PRIME-INDEX TO
                      PRIME-SRT-ENTRY-INDEX (PRIME-SRT-INDEX).
           PERFORM 5110-RETURN-PRIME-REC.
      ******************************************************************
       5129-EXIT.
      ******************************************************************
           EXIT.


      ******************************************************************
       5200-REPLACE-PRIME-IDS.
      ******************************************************************
           SET PRIME-INDEX
                 TO PRIME-SUBACCT-PRIME-INDEX (PRIME-SUBACCT-INDEX).
           MOVE PRIME-SUBACCT-ID (PRIME-SUBACCT-INDEX)
                      TO PRIME-TBL-ID (PRIME-INDEX).
      /************************************************************
       6000-EDIT-LINE-TABLE.
      ******************************************************************

           MOVE ZERO TO PAGE-COUNT.
           MOVE 99 TO LINE-COUNT.
           MOVE LOW-VALUES TO CALC-WORK-RECORD.
           MOVE LOW-VALUES TO LCF-RECORD.
           MOVE LOW-VALUES TO LDF-RECORD.
           OPEN INPUT  IN-LINE-FILE
                OUTPUT CALC-WORK-FILE
                OUTPUT LINE-CALC-FILE
                OUTPUT LINE-DESC-FILE.
           MOVE SPACES TO IN-LINE-FILE-STATUS.

           PERFORM 6010-READ-IN-LINE-FILE.

           IF  NOT END-OF-LINE-FILE
               MOVE ZERO TO LINE-ID-INDEX
               PERFORM 6020-EDIT-LINE-ENTRIES
                   UNTIL  END-OF-LINE-FILE
           ELSE
               DISPLAY '@@ NO ENTRIES ON LINE TABLE @@'
               MOVE '@@ NO ENTRIES ON LINE TABLE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           MOVE LINE-ID-INDEX TO LINE-COUNT-CT.
           MOVE NORMAL-LINE-COUNT TO LCF-NORMAL-ENTRIES.
           MOVE NORMAL-LINE-COUNT TO LDF-NORMAL-ENTRIES.
           MOVE CALC-ONLY-LINE-COUNT TO LCF-CALC-ONLY-ENTRIES.
           MOVE CALC-ONLY-LINE-COUNT TO LDF-CALC-ONLY-ENTRIES.
           PERFORM 6140-WRITE-LCF-RECORD.
           PERFORM 6145-WRITE-LDF-RECORD.
           MOVE LINE-ID-INDEX TO LCF-COUNT.
           MOVE LINE-ID-INDEX TO LDF-COUNT.
           CLOSE IN-LINE-FILE.
           CLOSE LINE-CALC-FILE.
           CLOSE LINE-DESC-FILE.
           MOVE LCF-COUNT TO CTR-LCF.
           MOVE LDF-COUNT TO CTR-LDF.
      ******************************************************************
       6010-READ-IN-LINE-FILE.
      ******************************************************************
           PERFORM 6015-READ-IN-LINE-FILE.
           PERFORM 6015-READ-IN-LINE-FILE UNTIL
               (IN-LINE-ID-BYTE-1 IS NOT = '/') OR
                   END-OF-LINE-FILE.
      ******************************************************************
       6015-READ-IN-LINE-FILE.
      ******************************************************************
           READ IN-LINE-FILE  INTO  IN-LINE-REC
               AT END
                   MOVE 'EOF' TO IN-LINE-FILE-STATUS.
      /*****************************************************************
       6020-EDIT-LINE-ENTRIES.
      ******************************************************************
           IF  IN-LINE-ID NOT =  SAVE-LINE-ID
           AND IN-LINE-ID  NOT =  SPACES
               MOVE NORMAL-LINE-COUNT TO LCF-NORMAL-ENTRIES
               MOVE NORMAL-LINE-COUNT TO LDF-NORMAL-ENTRIES
               MOVE CALC-ONLY-LINE-COUNT TO LCF-CALC-ONLY-ENTRIES
               MOVE CALC-ONLY-LINE-COUNT TO LDF-CALC-ONLY-ENTRIES
               PERFORM 6140-WRITE-LCF-RECORD
               PERFORM 6145-WRITE-LDF-RECORD
               PERFORM 6030-CHECK-LINE-ID
           ELSE
               PERFORM 6070-PROCESS-LINE-ENTRY
           END-IF.

      ******************************************************************
       6030-CHECK-LINE-ID.
      ******************************************************************
           MOVE LOW-VALUES TO LINE-COL-WORK-TABLE.
           MOVE 1 TO WORK-INDEX.
           PERFORM 6040-FIND-REPORT-IDS
               VARYING REPORT-INDEX FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                              =    HIGH-VALUES.
           IF  WORK-INDEX =  1
               PERFORM 6050-BYPASS-LINE-ID
           ELSE
               PERFORM 6060-SET-UP-NEW-LINE-ID
               PERFORM 6070-PROCESS-LINE-ENTRY
           END-IF.

      ******************************************************************
       6040-FIND-REPORT-IDS.
      ******************************************************************
           IF  RDT-LINE-ID (REPORT-INDEX) =  IN-LINE-ID-BYTES-2-3
               MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD
               MOVE LINE-ID-INDEX TO RDF-LINE-ID-INDEX
               MOVE RDF-ORG-ID-INDEX TO WORK-ORG (WORK-INDEX)
               MOVE RDF-REG-ID-INDEX TO WORK-REG (WORK-INDEX)
               SET WORK-RPT (WORK-INDEX) TO REPORT-INDEX
               MOVE RDF-RECORD TO REPORT-TABLE-ENTRY (REPORT-INDEX)
               ADD 1 TO WORK-INDEX
           END-IF.

           IF  WORK-INDEX  >  MAX-RPT-WORK-ENTRIES
               DISPLAY '@@ ERROR - LINE WORK TABLE OVERFLOW @@'
               DISPLAY '@@  INCREASE LINE WORK TABLE SIZE   @@'
               DISPLAY '@@  SHOULD BE SAME AS MAX-RDT   @@'
               MOVE '@@ ERROR - LINE WORK TABLE OVERFLOW @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE LINE WORK TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               MOVE '@@  SHOULD BE SAME AS MAX-RDT   @@'
                 TO W9999-ERROR-MESSAGE-3
               PERFORM 99999-ABORT
           END-IF.

      ******************************************************************
       6050-BYPASS-LINE-ID.
      ******************************************************************
           MOVE IN-LINE-ID TO CHECK-LINE-ID.
           PERFORM 6010-READ-IN-LINE-FILE
               UNTIL  END-OF-LINE-FILE
                  OR  IN-LINE-ID  NOT =  CHECK-LINE-ID.
      /*****************************************************************
       6060-SET-UP-NEW-LINE-ID.
      ******************************************************************
           ADD 1 TO LINE-ID-INDEX.
           MOVE ZERO TO LINE-ENTRY-INDEX.
           MOVE ZERO TO LAST-LINE-NUMBER.
           MOVE ZERO TO NORMAL-LINE-COUNT.
           MOVE ZERO TO CALC-ONLY-LINE-COUNT.
           MOVE 1 TO NEXT-LINE-NUMBER.
           MOVE IN-LINE-ID TO SAVE-LINE-ID.
           IF  LINE-ID-INDEX NOT >  MAX-LINE-TBL
               SET LINE-INDEX TO LINE-ID-INDEX
           ELSE
               DISPLAY '@@ ERROR : OVER LINE-ID-MAX OF 40 @@'
               MOVE '@@ ERROR : OVER LINE-ID-MAX OF 40 @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           MOVE IN-LINE-ID TO LINE-TBL-ID (LINE-INDEX).
           MOVE IN-LINE-TYPE TO LINE-TBL-TYPE (LINE-INDEX).
           MOVE SPACES TO H-LINE-ERROR-MSG.
           IF  IN-LINE-ID-BYTE-1 NOT =  'L'
               MOVE ERRMSG-INVALID-LINE-ID TO H-LINE-ERROR-MSG
               PERFORM 9990-SET-ERROR
           END-IF.

           MOVE SPACES TO H-L-TYPE-ERROR-MSG.
           IF  IN-LINE-TYPE NOT =  'O'
                       AND  NOT =  'P'
                       AND  NOT =  'R'
               MOVE ERRMSG-INVALID-LINE-TYPE TO H-L-TYPE-ERROR-MSG
               PERFORM 9990-SET-ERROR
           END-IF.

           MOVE IN-LINE-TYPE TO H-LINE-TYPE.
           PERFORM 6150-PRINT-LINE-HEADING.
           MOVE LOW-VALUES TO LCF-RECORD.
           MOVE LOW-VALUES TO LDF-RECORD.
           MOVE IN-LINE-TYPE TO LCF-TABLE-TYPE.
           MOVE IN-LINE-TYPE TO LDF-TABLE-TYPE.
           MOVE LINE-ID-INDEX TO LCF-ID-INDEX.
           MOVE LINE-ID-INDEX TO LDF-ID-INDEX.
           PERFORM 6010-READ-IN-LINE-FILE.
      /*****************************************************************
       6070-PROCESS-LINE-ENTRY.
      ******************************************************************
           IF  LINE-COUNT >  59
               PERFORM 6150-PRINT-LINE-HEADING
           END-IF.

           MOVE SPACES TO LINE-DETAIL-LINE.
           IF  IN-LINE-NUMBER-1 =  ' '
               MOVE '0' TO IN-LINE-NUMBER-1
           END-IF.

           IF  IN-LINE-NUMBER-2 =  ' '
               MOVE '0' TO IN-LINE-NUMBER-2
           END-IF.

           IF  IN-LINE-NUMBER-3 =  ' '
               MOVE '0' TO IN-LINE-NUMBER-3
           END-IF.

           IF  IN-LINE-NUMBER IS NOT NUMERIC
               ADD 1 TO LINE-ENTRY-INDEX
               MOVE IN-LINE-NUMBER-X TO D-LINE-NO-X
           ELSE
               IF  IN-LINE-NUMBER NOT =  ZERO
                   MOVE IN-LINE-NUMBER TO LINE-ENTRY-INDEX
                   MOVE LINE-ENTRY-INDEX TO D-LINE-NO
                   IF  LINE-ENTRY-INDEX NOT =  LAST-LINE-NUMBER
                       IF  IN-LINE-NUMBER > MAX-LINE
                           ADD 1 TO CALC-ONLY-LINE-COUNT
                       ELSE
                           ADD 1 TO NORMAL-LINE-COUNT
                       END-IF
                   END-IF
               END-IF
           END-IF.

           IF  NORMAL-LINE-COUNT >  MAX-LINE
               DISPLAY '@@ SYSTEM ERROR @@'
               DISPLAY '@@ NORMAL LINE COUNT > 162 @@'
               MOVE '@@ NORMAL LINE COUNT > 162 @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           MOVE IN-LINE-DESCRIPTION TO D-LINE-DESCRIPTION.
           MOVE IN-LINE-EDIT-TYPE TO D-LINE-EDIT-TYPE.
           MOVE IN-LINE-OPERAND (1) TO D-LINE-OPERAND (1).
           MOVE IN-LINE-OPERATOR (1) TO D-LINE-OPERATOR (1).
           MOVE IN-LINE-OPERAND (2) TO D-LINE-OPERAND (2).
           MOVE IN-LINE-OPERATOR (2) TO D-LINE-OPERATOR (2).
           MOVE IN-LINE-OPERAND (3) TO D-LINE-OPERAND (3).
           MOVE IN-LINE-OPERATOR (3) TO D-LINE-OPERATOR (3).
           MOVE IN-LINE-OPERAND (4) TO D-LINE-OPERAND (4).
           MOVE IN-LINE-OPERATOR (4) TO D-LINE-OPERATOR (4).
           MOVE IN-LINE-OPERAND (5) TO D-LINE-OPERAND (5).
           MOVE IN-LINE-OPERATOR (5) TO D-LINE-OPERATOR (5).
           MOVE IN-LINE-OPERAND (6) TO D-LINE-OPERAND (6).
           MOVE IN-LINE-OPERATOR (6) TO D-LINE-OPERATOR (6).
           MOVE IN-LINE-OPERAND (7) TO D-LINE-OPERAND (7).
           MOVE IN-LINE-OPERATOR (7) TO D-LINE-OPERATOR (7).
           MOVE IN-LINE-OPERAND (8) TO D-LINE-OPERAND (8).
           MOVE IN-LINE-OPERATOR (8) TO D-LINE-OPERATOR (8).

           MOVE LINE-HEADING-1    TO W0003-LINE-TYPE-DESC
           MOVE LINE-DETAIL-LINE  TO W0003-DETAIL-DATA

           WRITE FD-PRINTER-REC  FROM  LINE-DETAIL-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO LINE-DETAIL-LINE.
           ADD 1 TO LINE-COUNT.
           PERFORM 6073-CONTINUE-LINE-PROCESS.
      /*****************************************************************
       6073-CONTINUE-LINE-PROCESS.
      ******************************************************************
           IF  IN-LINE-NUMBER IS NOT NUMERIC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-NON-NUM-LINE TO D-LINE-ERROR-MSG
               MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  LINE-ENTRY-INDEX >  MAX-LINE
               IF  LAST-LINE-NUMBER <  MAX-LINE
                   MOVE LINE-ENTRY-INDEX TO NEXT-LINE-NUMBER
                   IF  LINE-ENTRY-INDEX NOT =  163
                       MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                       MOVE ERRMSG-NON-MAX-LINE TO D-LINE-ERROR-MSG
                       MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                       PERFORM 9999-WRITE-PRINTER
           END-IF.
           IF  LINE-ENTRY-INDEX NOT =  LAST-LINE-NUMBER
               IF  LINE-ENTRY-INDEX =  NEXT-LINE-NUMBER
                   MOVE ZERO TO LINE-CALC-COUNT
               ELSE
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-NON-SEQ-LINE TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  LINE-ENTRY-INDEX <  181
               PERFORM 6075-SET-UP-LCF-LDF
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-OVER-MAX-LINE TO D-LINE-ERROR-MSG
               MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  LINE-CALC-COUNT >  MAX-REL-LINE
               MOVE ERRMSG-OVER-MAX-LINE-CALCS TO D-LINE-ERROR-MSG
               MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           IF  IN-LINE-EDIT-TYPE =  ' '  OR  'P'  OR  'B'
                                         OR  'M'  OR  'T'  OR  '*'
               NEXT SENTENCE
           ELSE
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               MOVE ERRMSG-INVALID-LINE-EDIT TO D-LINE-ERROR-MSG
               MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.

           MOVE LINE-ENTRY-INDEX TO LAST-LINE-NUMBER.
           COMPUTE NEXT-LINE-NUMBER  =  LINE-ENTRY-INDEX + 1.
           PERFORM 6010-READ-IN-LINE-FILE.
      /*****************************************************************
       6075-SET-UP-LCF-LDF.
      ******************************************************************
           IF  LINE-ENTRY-INDEX NOT =  LAST-LINE-NUMBER
               MOVE IN-LINE-DESCRIPTION
                   TO LDF-DESCRIPTION (LINE-ENTRY-INDEX)
               MOVE IN-LINE-EDIT-TYPE
                   TO LCF-EDIT-FORMAT (LINE-ENTRY-INDEX)
               MOVE IN-LINE-EDIT-TYPE
                   TO LDF-EDIT-FORMAT (LINE-ENTRY-INDEX)
               MOVE SPACES
                   TO LCF-COL-CALC-FLAGS (LINE-ENTRY-INDEX)
               MOVE SPACE
                   TO LCF-LINE-CALC-FLAG (LINE-ENTRY-INDEX)
           END-IF.

           PERFORM 6080-FORMAT-LINE-CALC-RECS
               VARYING LINE-CALC-INDEX FROM 1 BY 1
               UNTIL LINE-CALC-INDEX  >  MAX-CALCS-ON-LINE
                  OR IN-LINE-OPERAND (LINE-CALC-INDEX)  =  SPACES.
      /*****************************************************************
       6080-FORMAT-LINE-CALC-RECS.
      ******************************************************************
           MOVE IN-LINE-OPERAND (LINE-CALC-INDEX) TO OPND-WORK.
           MOVE IN-LINE-OPERATOR (LINE-CALC-INDEX) TO OPTR-WORK.
           ADD 1 TO LINE-CALC-COUNT.
           IF  LINE-CALC-COUNT NOT >  MAX-REL-LINE
               MOVE IN-LINE-OPERAND (LINE-CALC-INDEX)
                TO LCF-OPERAND (LINE-ENTRY-INDEX, LINE-CALC-COUNT)
               MOVE IN-LINE-OPERATOR (LINE-CALC-INDEX)
                TO LCF-OPERATOR (LINE-ENTRY-INDEX, LINE-CALC-COUNT)
           END-IF.

           IF  OPND-WORK-BYTE-1 =  'C'
               AND OPND-WORK-BYTES-2-4  NUMERIC
               IF  OPTR-WORK =  'B'  OR  '-'
                   IF  OPND-WORK-BYTES-2-4 IS NOT > MAX-COL
                       MOVE OPTR-WORK TO  LCF-COL-CALC-FLAG
                           (LINE-ENTRY-INDEX, OPND-WORK-BYTES-2-4)
                   ELSE
                       MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                       MOVE ERRMSG-UNPRINTABLE-COL-CALC
                           TO D-LINE-ERROR-MSG
                       MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                       PERFORM 9999-WRITE-PRINTER
               ELSE
                   MOVE ERRMSG-INVALID-OPERATOR TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
           ELSE
           IF  OPND-WORK-BYTE-1 =  'L'
               AND OPND-WORK-BYTES-2-4  NUMERIC
               MOVE 'X' TO LCF-LINE-CALC-FLAG (LINE-ENTRY-INDEX)
               IF  OPND-WORK-BYTES-2-4 NOT <  LINE-ENTRY-INDEX
               AND OPND-WORK-BYTES-2-4  NOT >  MAX-LINE
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-INVALID-OPERAND TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               ELSE
               IF  OPTR-WORK =  '+'  OR  '-'  OR  '*'  OR  '/'
                   NEXT SENTENCE
               ELSE
                   MOVE ERRMSG-INVALID-OPERATOR TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
           ELSE
           IF  OPND-WORK-BYTE-1 =  'K'
               AND OPND-WORK-BYTES-2-4  NUMERIC
               IF  OPTR-WORK =  '+'  OR  '-'  OR  '*'  OR  '/'
                   MOVE 'X' TO LCF-LINE-CALC-FLAG (LINE-ENTRY-INDEX)
               ELSE
                   MOVE ERRMSG-INVALID-OPERATOR TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
           ELSE
           IF  OPTR-WORK =  '+'  OR  '-'  OR  '*'  OR  '/'
               MOVE OPTR-WORK TO CALC-REC-OPERATOR
               MOVE 'L' TO CALC-REC-LCP-FLAG
               MOVE LINE-ENTRY-INDEX TO CALC-REC-LINE-COL-NO
               MOVE LINE-CALC-COUNT TO CALC-REC-REL-CALC
               MOVE ZERO TO CHECK-ORG-ID-INDEX
               MOVE ZERO TO CHECK-REG-ID-INDEX
               PERFORM 6090-CHECK-LINE-TABLE-TYPE
                   VARYING WORK-INDEX  FROM 1 BY 1
                   UNTIL WORK-INDEX  >  MAX-RPT-WORK-ENTRIES
                      OR WORK-RPT (WORK-INDEX)  =  ZERO
           ELSE
               MOVE ERRMSG-INVALID-OPERATOR TO D-LINE-ERROR-MSG
               MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
      /*****************************************************************
       6090-CHECK-LINE-TABLE-TYPE.
      ******************************************************************
           MOVE WORK-RPT (WORK-INDEX) TO CALC-REC-REPORT-INDEX.
           IF  LCF-TABLE-TYPE =  'P'
               IF  WORK-INDEX =  1
                   MOVE 'N' TO MNEMONIC-FOUND-FLAG
                   PERFORM 6120-FORMAT-LINE-PRI-CALC-REC
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  LCF-TABLE-TYPE =  'O'
               IF  WORK-ORG (WORK-INDEX) NOT =  CHECK-ORG-ID-INDEX
                   MOVE 'N' TO MNEMONIC-FOUND-FLAG
                   PERFORM 6100-FORMAT-LINE-ORG-CALC-REC
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  LCF-TABLE-TYPE =  'R'
               IF  WORK-REG (WORK-INDEX) NOT =  CHECK-REG-ID-INDEX
                   MOVE 'N' TO MNEMONIC-FOUND-FLAG
                   PERFORM 6110-FORMAT-LINE-REG-CALC-REC
           END-IF.

           IF  MNEMONIC-FOUND-FLAG =  'Y'
               PERFORM 6130-WRITE-CALC-WORK-REC
           END-IF.
      ******************************************************************
       6100-FORMAT-LINE-ORG-CALC-REC.
      ******************************************************************
           MOVE 'O' TO CALC-REC-TYPE.
           MOVE WORK-ORG (WORK-INDEX) TO CHECK-ORG-ID-INDEX.
           MOVE WORK-ORG (WORK-INDEX) TO WORK-KEY-ID-INDEX.
           MOVE OPND-WORK TO WORK-KEY-MNEM.
           SEARCH ALL ORG-MNEMONIC-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-UNDEFINED-MNEMONIC TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               WHEN
                ORG-MNEMONIC-KEY (ORG-M-INDEX) = WORK-KEY
                   COMPUTE  CALC-REC-REL-REC  =
                     ((WORK-ORG (WORK-INDEX) - 1)  *  MAX-ORG)
                     +  (ORG-MNEMONIC-ENTRY-INDEX (ORG-M-INDEX))
                   MOVE 'Y' TO MNEMONIC-FOUND-FLAG
                   MOVE CHECK-ORG-ID-INDEX TO ORG-ID-INDEX
                   MOVE ORG-MNEMONIC-ENTRY-INDEX (ORG-M-INDEX)
                   TO ORG-ENTRY-INDEX
                   MOVE 'Y' TO ORG-TBL-USAGE-FLAG
                        (ORG-ID-INDEX, ORG-ENTRY-INDEX).
      /*****************************************************************
       6110-FORMAT-LINE-REG-CALC-REC.
      ******************************************************************
           MOVE 'R' TO CALC-REC-TYPE.
           MOVE WORK-REG (WORK-INDEX) TO CHECK-REG-ID-INDEX.
           MOVE WORK-REG (WORK-INDEX) TO WORK-KEY-ID-INDEX.
           MOVE OPND-WORK TO WORK-KEY-MNEM.
           SEARCH ALL REG-MNEMONIC-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-UNDEFINED-MNEMONIC TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               WHEN REG-MNEMONIC-KEY (REG-M-INDEX) = WORK-KEY
                   COMPUTE  CALC-REC-REL-REC  =
                     ((WORK-REG (WORK-INDEX) - 1)  *  MAX-REG)
                     +  (REG-MNEMONIC-ENTRY-INDEX (REG-M-INDEX))
                   MOVE 'Y' TO MNEMONIC-FOUND-FLAG
                   SET REG-ID-INDEX TO CHECK-REG-ID-INDEX
                   SET REG-ENTRY-INDEX TO
                            REG-MNEMONIC-ENTRY-INDEX (REG-M-INDEX)
                   MOVE 'Y' TO REG-TBL-USAGE-FLAG
                        (REG-ID-INDEX, REG-ENTRY-INDEX).
      ******************************************************************
       6120-FORMAT-LINE-PRI-CALC-REC.
      ******************************************************************
           MOVE 'P' TO CALC-REC-TYPE.
           SEARCH ALL PRIME-ID-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-UNDEFINED-PRIME TO D-LINE-ERROR-MSG
                   MOVE LINE-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               WHEN  PRIME-SRT-ID (PRIME-SRT-INDEX)  =  OPND-WORK
                   MOVE PRIME-SRT-ENTRY-INDEX (PRIME-SRT-INDEX)
                       TO CALC-REC-REL-REC
                   MOVE 'Y' TO
                           PRIME-TBL-USAGE-FLAG (CALC-REC-REL-REC)
                   MOVE 'Y' TO MNEMONIC-FOUND-FLAG.
      /*****************************************************************
       6130-WRITE-CALC-WORK-REC.
      ******************************************************************
           WRITE FD-CALC-WORK-REC  FROM  CALC-WORK-RECORD.
      ****************************************   ***********************
       6140-WRITE-LCF-RECORD.
      ******************************************************************
           IF  LCF-RECORD NOT =  HIGH-VALUES
               MOVE LCF-ID-INDEX TO REL-REC-LCF.
           IF  LCF-ID-INDEX NOT =  ZERO
           AND  REL-REC-LCF  NOT >  MAX-LINE-TBL
               WRITE FD-LINE-CALC-FILE-REC  FROM  LCF-RECORD.
           IF  LCF-RECORD =  HIGH-VALUES
               WRITE FD-LINE-CALC-FILE-REC  FROM  LCF-RECORD.
           MOVE LOW-VALUES TO LCF-RECORD.
      ******************************************************************
       6145-WRITE-LDF-RECORD.
      ******************************************************************
           IF  LDF-RECORD NOT =  HIGH-VALUES
               MOVE LDF-ID-INDEX TO REL-REC-LDF.
           IF  LDF-ID-INDEX NOT =  ZERO
           AND  REL-REC-LDF  NOT >  MAX-LINE-TBL
               WRITE FD-LINE-DESC-FILE-REC  FROM  LDF-RECORD.
           IF  LDF-RECORD =  HIGH-VALUES
               WRITE FD-LINE-DESC-FILE-REC  FROM  LDF-RECORD.
           MOVE LOW-VALUES TO LDF-RECORD.
      ******************************************************************
       6150-PRINT-LINE-HEADING.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE LINE-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           MOVE IN-LINE-ID TO H-LINE-ID.
           WRITE FD-PRINTER-REC  FROM  LINE-HEADING-1
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  LINE-HEADING-2
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE 6 TO LINE-COUNT.
      /*****************************************************************
       7000-EDIT-COLUMN-TABLE.
      ******************************************************************

           MOVE ZERO TO PAGE-COUNT.
           MOVE 99 TO LINE-COUNT.
           MOVE SPACES TO COL-WORK-TABLE.
           MOVE LOW-VALUES TO CALC-WORK-RECORD.
           MOVE LOW-VALUES TO CBF-RECORD.
           OPEN INPUT  IN-COL-FILE
                OUTPUT COL-BDAM-FILE.
           MOVE SPACES TO IN-COL-FILE-STATUS.
           PERFORM 7010-READ-IN-COL-FILE.
           IF  NOT END-OF-COL-FILE
               MOVE ZERO TO COL-ID-INDEX
               PERFORM 7020-EDIT-COL-ENTRIES
                   UNTIL  END-OF-COL-FILE
           ELSE
               DISPLAY '@@ NO ENTRIES ON COLUMN TABLE @@'
               MOVE '@@ NO ENTRIES ON COLUMN TABLE @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT.
           MOVE COL-ID-INDEX TO COL-COUNT.
           MOVE COL-ENTRY-INDEX TO CBF-NO-OF-ENTRIES.
           MOVE COL-ENTRY-INDEX TO FD-COL-BDAM-ENTRY-CT.
           PERFORM 7140-WRITE-CBF-RECORD.
           MOVE COL-ID-INDEX TO CBF-COUNT.
           CLOSE IN-COL-FILE.
           CLOSE COL-BDAM-FILE.
           MOVE CBF-COUNT TO CTR-CBF.
      ******************************************************************
       7010-READ-IN-COL-FILE.
      ******************************************************************
           PERFORM 7015-READ-IN-COL-FILE.
           PERFORM 7015-READ-IN-COL-FILE UNTIL
               (IN-COL-ID-BYTE-1 IS NOT = '/') OR
                   END-OF-COL-FILE.
      ******************************************************************
       7015-READ-IN-COL-FILE.
      ******************************************************************
           READ IN-COL-FILE  INTO  IN-COL-REC
               AT END
                   MOVE 'EOF' TO IN-COL-FILE-STATUS.
      ******************************************************************
       7020-EDIT-COL-ENTRIES.
      ******************************************************************
           IF  IN-COL-ID NOT =  SAVE-COL-ID
               MOVE COL-ENTRY-INDEX TO CBF-NO-OF-ENTRIES
               MOVE COL-ENTRY-INDEX TO FD-COL-BDAM-ENTRY-CT
               PERFORM 7140-WRITE-CBF-RECORD
               PERFORM 7030-CHECK-COL-ID
           ELSE
               PERFORM 7070-PROCESS-COL-ENTRY
           END-IF.

      /*****************************************************************
       7030-CHECK-COL-ID.
      ******************************************************************
           MOVE LOW-VALUES TO LINE-COL-WORK-TABLE.
           MOVE 1 TO WORK-INDEX.
           PERFORM 7040-FIND-REPORT-IDS
               VARYING REPORT-INDEX FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                           =    HIGH-VALUES.
           IF  WORK-INDEX =  1
               PERFORM 7050-BYPASS-COL-ID
           ELSE
               PERFORM 7060-SET-UP-NEW-COL-ID
               PERFORM 7070-PROCESS-COL-ENTRY
           END-IF.

      ******************************************************************
       7040-FIND-REPORT-IDS.
      ******************************************************************
           IF  RDT-COL-ID (REPORT-INDEX) =  IN-COL-ID-BYTES-2-3
               MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD
               MOVE COL-ID-INDEX TO RDF-COLUMN-ID-INDEX
               MOVE RDF-ORG-ID-INDEX TO WORK-ORG (WORK-INDEX)
               MOVE RDF-REG-ID-INDEX TO WORK-REG (WORK-INDEX)
               SET WORK-RPT (WORK-INDEX) TO REPORT-INDEX
               MOVE RDF-RECORD TO REPORT-TABLE-ENTRY (REPORT-INDEX)
               ADD 1 TO WORK-INDEX
           END-IF.

           IF  WORK-INDEX  >  MAX-RDT
               DISPLAY '@@ ERROR - COL WORK TABLE OVERFLOW @@'
               DISPLAY '@@  INCREASE COL WORK TABLE SIZE   @@'
               DISPLAY '@@  SHOULD BE SAME AS MAX-RDT   @@'
               MOVE '@@ ERROR - COL WORK TABLE OVERFLOW @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE COL WORK TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               MOVE '@@  SHOULD BE SAME AS MAX-RDT   @@'
                 TO W9999-ERROR-MESSAGE-3
               PERFORM 99999-ABORT
           END-IF.

      /*****************************************************************
       7050-BYPASS-COL-ID.
      ******************************************************************
           MOVE IN-COL-ID TO CHECK-COL-ID.
           PERFORM 7010-READ-IN-COL-FILE
               UNTIL  END-OF-COL-FILE
                  OR  IN-COL-ID  NOT =  CHECK-COL-ID.
      ******************************************************************
       7060-SET-UP-NEW-COL-ID.
      ******************************************************************
           ADD 1 TO COL-ID-INDEX.
           MOVE ZERO TO COL-ENTRY-INDEX.
           MOVE ZERO TO LAST-COL-NUMBER.
           MOVE 1 TO NEXT-COL-NUMBER.
           MOVE IN-COL-ID TO SAVE-COL-ID.
           IF  COL-ID-INDEX NOT >  MAX-COL-TBL
               SET COL-INDEX TO COL-ID-INDEX
           ELSE
               DISPLAY '@@ ERROR : OVER COLUMN-TABLE-MAX OF 50 @@'
               MOVE '@@ ERROR : OVER COLUMN-TABLE-MAX OF 50 @@'
                 TO W9999-ERROR-MESSAGE-1
               PERFORM 99999-ABORT
           END-IF.

           MOVE IN-COL-ID TO COL-TBL-ID (COL-INDEX).
           MOVE IN-COL-TYPE TO COL-TBL-TYPE (COL-INDEX).
           MOVE SPACES TO H-COL-ERROR-MSG.
           IF  IN-COL-ID-BYTE-1 NOT =  'C'
               MOVE ERRMSG-INVALID-COL-ID TO H-COL-ERROR-MSG
               PERFORM 9990-SET-ERROR
           END-IF.

           MOVE IN-COL-TYPE TO H-COL-TYPE.
           MOVE SPACES TO H-C-TYPE-ERROR-MSG.
           IF  IN-COL-TYPE NOT =  'O'
                      AND  NOT =  'P'
                      AND  NOT =  'R'
                      AND  NOT =  ' '
               MOVE ERRMSG-INVALID-COL-TYPE TO H-C-TYPE-ERROR-MSG
               PERFORM 9990-SET-ERROR
           END-IF.

           PERFORM 7150-PRINT-COL-HEADING.
           MOVE LOW-VALUES TO CBF-RECORD.
           MOVE IN-COL-TYPE TO CBF-TABLE-TYPE.
           MOVE COL-ID-INDEX TO CBF-ID-INDEX.
           PERFORM 7010-READ-IN-COL-FILE.
      /*****************************************************************
       7070-PROCESS-COL-ENTRY.
      ******************************************************************
           IF  LINE-COUNT >  59
               PERFORM 7150-PRINT-COL-HEADING.
           MOVE SPACES TO COL-DETAIL-LINE.
           IF  IN-COL-NUMBER-1 =  ' '
               MOVE '0' TO IN-COL-NUMBER-1.
           IF  IN-COL-NUMBER-2 =  ' '
               MOVE '0' TO IN-COL-NUMBER-2.
           IF  IN-COL-NUMBER IS NUMERIC
               MOVE IN-COL-NUMBER TO COL-ENTRY-INDEX
               MOVE COL-ENTRY-INDEX TO D-COL-NO
           ELSE
               ADD 1 TO COL-ENTRY-INDEX
               MOVE IN-COL-NUMBER-X TO D-COL-NO-X.
           IF  COL-ENTRY-INDEX NOT > MAX-PRINTABLE-COL
               ADD 1 TO CBF-PRINT-ENTRIES.
           MOVE 'X' TO
              COL-WORK-TABLE-FLAG (COL-ID-INDEX, COL-ENTRY-INDEX).
           IF  IN-COL-DESCRIPTION-1 =  'DEFAULT'
           OR IN-COL-DESCRIPTION-2  =  'DEFAULT'
               MOVE 'D' TO
                 COL-WORK-TABLE-FLAG (COL-ID-INDEX, COL-ENTRY-INDEX).
           MOVE IN-COL-DESCRIPTION-1 TO D-COL-DESCRIPTION-1.
           MOVE IN-COL-DESCRIPTION-2 TO D-COL-DESCRIPTION-2.
           MOVE IN-COL-EDIT-TYPE TO D-COL-EDIT-TYPE.
           MOVE IN-COL-OPERAND (1) TO D-COL-OPERAND (1).
           MOVE IN-COL-OPERATOR (1) TO D-COL-OPERATOR (1).
           MOVE IN-COL-OPERAND (2) TO D-COL-OPERAND (2).
           MOVE IN-COL-OPERATOR (2) TO D-COL-OPERATOR (2).
           MOVE IN-COL-OPERAND (3) TO D-COL-OPERAND (3).
           MOVE IN-COL-OPERATOR (3) TO D-COL-OPERATOR (3).
           MOVE IN-COL-OPERAND (4) TO D-COL-OPERAND (4).
           MOVE IN-COL-OPERATOR (4) TO D-COL-OPERATOR (4).
           MOVE IN-COL-OPERAND (5) TO D-COL-OPERAND (5).
           MOVE IN-COL-OPERATOR (5) TO D-COL-OPERATOR (5).
           MOVE IN-COL-OPERAND (6) TO D-COL-OPERAND (6).
           MOVE IN-COL-OPERATOR (6) TO D-COL-OPERATOR (6).
           MOVE IN-COL-OPERAND (7) TO D-COL-OPERAND (7).
           MOVE IN-COL-OPERATOR (7) TO D-COL-OPERATOR (7).
           MOVE IN-COL-OPERAND (8) TO D-COL-OPERAND (8).
           MOVE IN-COL-OPERATOR (8) TO D-COL-OPERATOR (8).
           MOVE IN-COL-OPERAND (9) TO D-COL-OPERAND (9).
           MOVE IN-COL-OPERATOR (9) TO D-COL-OPERATOR (9).
           MOVE IN-COL-OPERAND (10) TO D-COL-OPERAND (10).
           MOVE IN-COL-OPERATOR (10) TO D-COL-OPERATOR (10).
           MOVE IN-COL-OPERAND (11) TO D-COL-OPERAND (11).
           MOVE IN-COL-OPERATOR (11) TO D-COL-OPERATOR (11).

           MOVE COL-HEADING-1     TO W0003-LINE-TYPE-DESC
           MOVE COL-DETAIL-LINE   TO W0003-DETAIL-DATA

           WRITE FD-PRINTER-REC  FROM  COL-DETAIL-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO COL-DETAIL-LINE.
           ADD 1 TO LINE-COUNT.
           PERFORM 7073-CONTINUE-COL-PROCESS.
      /*****************************************************************
       7073-CONTINUE-COL-PROCESS.
      ******************************************************************
           IF  IN-COL-NUMBER IS NOT NUMERIC
               MOVE ERRMSG-NON-NUM-COL TO D-COL-ERROR-MSG
               MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
           IF  COL-ENTRY-INDEX NOT =  NEXT-COL-NUMBER
           AND COL-ENTRY-INDEX  NOT =  MAX-PRINTABLE-COL + 1
               MOVE ERRMSG-NON-SEQ-COL TO D-COL-ERROR-MSG
               MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
           IF  COL-ENTRY-INDEX IS NOT GREATER THAN MAX-COL
               PERFORM 7075-SET-UP-CBF
           ELSE
               MOVE ERRMSG-OVER-MAX-COL TO D-COL-ERROR-MSG
               MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
           IF  IN-COL-EDIT-TYPE =  ' '  OR  'P'  OR  'B'  OR  'L'
               NEXT SENTENCE
           ELSE
               MOVE ERRMSG-INVALID-COL-EDIT TO D-COL-ERROR-MSG
               MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
           MOVE COL-ENTRY-INDEX TO LAST-COL-NUMBER.
           COMPUTE NEXT-COL-NUMBER  =  COL-ENTRY-INDEX + 1.
           PERFORM 7010-READ-IN-COL-FILE.
      /*****************************************************************
       7075-SET-UP-CBF.
      ******************************************************************
           MOVE IN-COL-DESCRIPTION-1
               TO CBF-HEADING-1 (COL-ENTRY-INDEX).
           MOVE IN-COL-DESCRIPTION-2
               TO CBF-HEADING-2 (COL-ENTRY-INDEX).
           MOVE IN-COL-EDIT-TYPE
               TO CBF-EDIT-FORMAT (COL-ENTRY-INDEX).
           MOVE IN-COL-CALCULATION-AREA
               TO CBF-CALCULATION-AREA (COL-ENTRY-INDEX).
           MOVE SPACE TO CBF-COL-CALC-FLAG (COL-ENTRY-INDEX).
           PERFORM 7080-FORMAT-COL-CALC-RECS
               VARYING COL-CALC-INDEX FROM 1 BY 1
               UNTIL COL-CALC-INDEX  >  MAX-CALCS-ON-COL
                  OR IN-COL-OPERAND (COL-CALC-INDEX)  =  SPACES.
      /*****************************************************************
       7080-FORMAT-COL-CALC-RECS.
      ******************************************************************
           MOVE IN-COL-OPERAND (COL-CALC-INDEX) TO OPND-WORK.
           MOVE IN-COL-OPERATOR (COL-CALC-INDEX) TO OPTR-WORK.

      * USE A SPECIAL FIELD IF THE OPERATOR IS O/P/R. MOVE AN '=' SIGN
      * INTO THE OPERATOR FOR THE CALCULATOR TO PICK UP AND BUILD A
      * SPECIAL SORT-RECORD.        CPL

           MOVE ' ' TO COL-OPTR-WORK.
           IF  OPTR-WORK = 'O' OR 'P' OR 'R'
               MOVE OPTR-WORK TO COL-OPTR-WORK
               MOVE '=' TO OPTR-WORK.
           IF  OPND-WORK-BYTE-1 =  'C'
               AND OPND-WORK-BYTES-2-4  NUMERIC
               MOVE 'X' TO CBF-COL-CALC-FLAG (COL-ENTRY-INDEX)
               IF  OPND-WORK-BYTES-2-4 > MAX-COL
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-INVALID-OPERAND TO D-COL-ERROR-MSG
                   MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               ELSE
                   IF  OPND-WORK-BYTES-2-4 NOT <  COL-ENTRY-INDEX
                       IF  COL-ENTRY-INDEX NOT >  MAX-PRINTABLE-COL
                          AND OPND-WORK-BYTES-2-4 > MAX-PRINTABLE-COL
                              NEXT SENTENCE
                       ELSE
                         MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                         MOVE ERRMSG-INVALID-OPERAND TO D-COL-ERROR-MSG
                         MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
                       PERFORM 9999-WRITE-PRINTER
                   ELSE
                       NEXT SENTENCE
           ELSE
           IF  OPND-WORK-BYTE-1 =  'K'
           AND OPND-WORK-BYTES-2-4  NUMERIC
                   NEXT SENTENCE
           ELSE
               MOVE OPTR-WORK TO CALC-REC-OPERATOR
               MOVE 'C' TO CALC-REC-LCP-FLAG
               MOVE COL-ENTRY-INDEX TO CALC-REC-LINE-COL-NO
               MOVE COL-CALC-INDEX TO CALC-REC-REL-CALC
               MOVE ZERO TO CHECK-ORG-ID-INDEX
               MOVE ZERO TO CHECK-REG-ID-INDEX
               MOVE 'N' TO MNEMONIC-FOUND-FLAG
               PERFORM 7090-CHECK-COL-TABLE-TYPE
                   VARYING WORK-INDEX  FROM 1 BY 1
                   UNTIL WORK-INDEX  >  MAX-RPT-WORK-ENTRIES
                      OR WORK-RPT (WORK-INDEX)  =  ZERO
               IF  OPTR-WORK =  '*'  OR  '/'
                   MOVE ERRMSG-INVALID-OPERATOR TO D-COL-ERROR-MSG
                   MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
           END-IF.
           IF  OPTR-WORK =  '+'  OR  '-'  OR  '*'  OR  '/'  OR  '|'
                         OR '='
               NEXT SENTENCE
           ELSE
               MOVE ERRMSG-INVALID-OPERATOR TO D-COL-ERROR-MSG
               MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
               MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
               PERFORM 9999-WRITE-PRINTER
           END-IF.
      /*****************************************************************
       7090-CHECK-COL-TABLE-TYPE.
      ******************************************************************
           MOVE WORK-RPT (WORK-INDEX) TO CALC-REC-REPORT-INDEX.
           IF  COL-OPTR-WORK NOT = SPACE
               MOVE COL-OPTR-WORK TO COL-SEARCH-TYPE
           ELSE
               MOVE CBF-TABLE-TYPE TO COL-SEARCH-TYPE.
           IF  COL-SEARCH-TYPE =  'P'
               IF  WORK-INDEX =  1
                   MOVE 'N' TO MNEMONIC-FOUND-FLAG
                   PERFORM 7120-FORMAT-COL-PRI-CALC-REC
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  COL-SEARCH-TYPE =  'O'
               IF  WORK-ORG (WORK-INDEX) NOT =  CHECK-ORG-ID-INDEX
                   MOVE 'N' TO MNEMONIC-FOUND-FLAG
                   PERFORM 7100-FORMAT-COL-ORG-CALC-REC
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  COL-SEARCH-TYPE =  'R'
               IF  WORK-REG (WORK-INDEX) NOT =  CHECK-REG-ID-INDEX
                   MOVE 'N' TO MNEMONIC-FOUND-FLAG
                   PERFORM 7110-FORMAT-COL-REG-CALC-REC
           END-IF.

           IF  MNEMONIC-FOUND-FLAG =  'Y'
               PERFORM 6130-WRITE-CALC-WORK-REC
           END-IF.

      /*****************************************************************
       7100-FORMAT-COL-ORG-CALC-REC.
      ******************************************************************
           MOVE 'O' TO CALC-REC-TYPE.
           MOVE WORK-ORG (WORK-INDEX) TO CHECK-ORG-ID-INDEX.
           MOVE WORK-ORG (WORK-INDEX) TO WORK-KEY-ID-INDEX.
           MOVE OPND-WORK TO WORK-KEY-MNEM.
           SEARCH ALL ORG-MNEMONIC-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-UNDEFINED-MNEMONIC TO D-COL-ERROR-MSG
                   MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
      *            DISPLAY ' ** SEARCHING FOR KEY = '
      *               WORK-KEY-ID-INDEX ' ' WORK-KEY-MNEM
               WHEN
               ORG-MNEMONIC-KEY (ORG-M-INDEX) = WORK-KEY
                   COMPUTE  CALC-REC-REL-REC  =
                     ((WORK-ORG (WORK-INDEX) - 1)  *  MAX-ORG)
                     +  (ORG-MNEMONIC-ENTRY-INDEX (ORG-M-INDEX))
                   MOVE 'Y' TO MNEMONIC-FOUND-FLAG
                   MOVE CHECK-ORG-ID-INDEX TO ORG-ID-INDEX
                   MOVE ORG-MNEMONIC-ENTRY-INDEX (ORG-M-INDEX)
                        TO ORG-ENTRY-INDEX
                   MOVE 'Y' TO ORG-TBL-USAGE-FLAG
                        (ORG-ID-INDEX, ORG-ENTRY-INDEX).
      ******************************************************************
       7110-FORMAT-COL-REG-CALC-REC.
      ******************************************************************
           MOVE 'R' TO CALC-REC-TYPE.
           MOVE WORK-REG (WORK-INDEX) TO CHECK-REG-ID-INDEX.
           MOVE WORK-REG (WORK-INDEX) TO WORK-KEY-ID-INDEX.
           MOVE OPND-WORK TO WORK-KEY-MNEM.
           SEARCH ALL REG-MNEMONIC-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-UNDEFINED-MNEMONIC TO D-COL-ERROR-MSG
                   MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
      *            DISPLAY ' ** SEARCHING FOR KEY = '
      *               WORK-KEY-ID-INDEX ' ' WORK-KEY-MNEM
               WHEN REG-MNEMONIC-KEY (REG-M-INDEX) = WORK-KEY
                   COMPUTE  CALC-REC-REL-REC  =
                     ((WORK-REG (WORK-INDEX) - 1)  *  MAX-REG)
                     +  (REG-MNEMONIC-ENTRY-INDEX (REG-M-INDEX))
                   MOVE 'Y' TO MNEMONIC-FOUND-FLAG
                   SET REG-ID-INDEX TO CHECK-REG-ID-INDEX
                   SET REG-ENTRY-INDEX TO
                            REG-MNEMONIC-ENTRY-INDEX (REG-M-INDEX)
                   MOVE 'Y' TO REG-TBL-USAGE-FLAG
                        (REG-ID-INDEX, REG-ENTRY-INDEX).
      /*****************************************************************
       7120-FORMAT-COL-PRI-CALC-REC.
      ******************************************************************
           MOVE 'P' TO CALC-REC-TYPE.
           SEARCH ALL PRIME-ID-TABLE-ENTRIES
               AT END
                   MOVE FD-PRINTER-REC  TO W0002-PRINTER-REC
                   MOVE ERRMSG-UNDEFINED-PRIME TO D-COL-ERROR-MSG
                   MOVE COL-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 9999-WRITE-PRINTER
               WHEN  PRIME-SRT-ID (PRIME-SRT-INDEX)  =  OPND-WORK
                   MOVE PRIME-SRT-ENTRY-INDEX (PRIME-SRT-INDEX)
                       TO CALC-REC-REL-REC
                   MOVE 'Y' TO
                        PRIME-TBL-USAGE-FLAG (CALC-REC-REL-REC)
                   MOVE 'Y' TO MNEMONIC-FOUND-FLAG.
      ******************************************************************
       7140-WRITE-CBF-RECORD.
      ******************************************************************
           IF  CBF-RECORD NOT =  HIGH-VALUES
               MOVE CBF-ID-INDEX TO REL-REC-CBF.
           IF  CBF-ID-INDEX NOT =  ZERO
           AND  REL-REC-CBF  NOT >  MAX-COL-TBL
               WRITE FD-COL-BDAM-FILE-REC  FROM  CBF-RECORD.
           IF  CBF-RECORD =  HIGH-VALUES
               WRITE FD-COL-BDAM-FILE-REC  FROM  CBF-RECORD.
           MOVE LOW-VALUES TO CBF-RECORD.
      ******************************************************************
       7150-PRINT-COL-HEADING.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE COL-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           MOVE IN-COL-ID TO H-COL-ID.
           WRITE FD-PRINTER-REC  FROM  COL-HEADING-1
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  COL-HEADING-2
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  COL-HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE 8 TO LINE-COUNT.
      /**************************************************************
       8000-PERIOD-UPDATE.
      ***************************************************************
           OPEN INPUT MNEMONIC-FILE
                OUTPUT DATE-FILE.
           PERFORM 8010-GET-GL-HEADER.
           IF  NOT END-OF-GL
               PERFORM 8005-READ-IN-MNEMONIC-FILE
               PERFORM 8003-READ-IN-MNEMONIC-TABLE
                   VARYING MNEMONIC-INDEX FROM 1 BY 1
                   UNTIL FD-MNEMONIC-TABLE-TYPE = 'F'
               PERFORM 8004-READ-IN-POINTER-TABLE
                   VARYING POINTER-INDEX FROM 1 BY 1
                   UNTIL END-OF-MNEMONIC-FILE
               PERFORM 8020-FORMAT-DTH-RECORD
               PERFORM 8025-LOAD-HEADING-DATE-INFO
               PERFORM 8040-FORMAT-DTD-RECORD
                   VARYING PER-MNEM-INDEX FROM 1 BY 1
                   UNTIL  PER-MNEM-INDEX  >  MAX-PER-MNEMS
           END-IF.

           CLOSE MNEMONIC-FILE
                 DATE-FILE.
           MOVE DTF-COUNT TO CTR-DTF.
      ******************************************************************
       8003-READ-IN-MNEMONIC-TABLE.
      ******************************************************************
           IF  FD-MNEMONIC-TABLE-TYPE = 'V'
               MOVE FD-MNEMONIC-RECORD TO
                   PERIOD-MNEM-RECORD (MNEMONIC-INDEX).
           PERFORM 8005-READ-IN-MNEMONIC-FILE.
      ******************************************************************
       8004-READ-IN-POINTER-TABLE.
      ******************************************************************
           IF  FD-MNEMONIC-TABLE-TYPE = 'F'
               MOVE FD-MNEMONIC-RECORD TO
                   PERIOD-MNEMONIC-POINTER-RECORD (POINTER-INDEX).
           PERFORM 8005-READ-IN-MNEMONIC-FILE.
      ******************************************************************
       8005-READ-IN-MNEMONIC-FILE.
      ******************************************************************
           PERFORM 8006-READ-IN-MNEMONIC-FILE.
           PERFORM 8006-READ-IN-MNEMONIC-FILE UNTIL
               FD-MNEMONIC-TABLE-TYPE = 'V' OR 'F' OR
                   END-OF-MNEMONIC-FILE.
      ******************************************************************
       8006-READ-IN-MNEMONIC-FILE.
      ******************************************************************
           READ MNEMONIC-FILE
               AT END
                   MOVE 'EOF' TO IN-MNEMONIC-FILE-STATUS.
      ***************************************************************
       8010-GET-GL-HEADER.
      ***************************************************************
           OPEN INPUT GL-MASTER-FILE.
           READ GL-MASTER-FILE  INTO  GL-HEADER-RECORD
               AT END
                   MOVE 'EOF' TO GL-FILE-STATUS.
           CLOSE GL-MASTER-FILE.
      ***************************************************************
       8020-FORMAT-DTH-RECORD.
      ***************************************************************
           MOVE SPACES TO DTH-RECORD.
           MOVE '1' TO DTH-SYSID.
           MOVE GL-H-CURR-PERIOD   TO DTH-FISCAL-PERIOD
                                      CURR-PERIOD.
           MOVE GL-H-FISCAL-YEAR   TO DTH-FISCAL-YEAR.
           MOVE GL-H-PER-END-MONTH TO DTH-PERIOD-END-MONTH.
           MOVE GL-H-PER-END-DAY   TO DTH-PERIOD-END-DAY.
           MOVE GL-H-PER-END-YEAR  TO DTH-PERIOD-END-YEAR.
           WRITE FD-DATE-FILE-REC  FROM  DTH-RECORD.
           ADD 1 TO DTF-COUNT.
      ***************************************************************
       8025-LOAD-HEADING-DATE-INFO.
      ***************************************************************

           ACCEPT W0001-CURRENT-FR-DATE  FROM DATE.

           MOVE W0001-CURRENT-FR-DD      TO W0001-CURRENT-TO-DD.
           MOVE W0001-CURRENT-FR-MM      TO W0001-CURRENT-TO-MM.
           MOVE W0001-CURRENT-FR-YY      TO W0001-CURRENT-TO-YY.

           MOVE W0001-CURRENT-TO-DATE    TO H-DATE.

           ACCEPT W0001-CURRENT-FR-TIME  FROM TIME.

           MOVE W0001-CURRENT-FR-HH      TO W0001-CURRENT-TO-HH.
           MOVE W0001-CURRENT-FR-MN      TO W0001-CURRENT-TO-MN
           MOVE W0001-CURRENT-FR-SS      TO W0001-CURRENT-TO-SS.

           MOVE W0001-CURRENT-TO-TIME    TO WORK-TIME.

           MOVE MIN TO H-MIN.
           IF  HRS < 12
               MOVE 'AM' TO H-AM-PM
               IF  HRS = 00
                   MOVE 12 TO H-HRS
               ELSE
                   MOVE HRS TO H-HRS
               END-IF
           ELSE
               MOVE 'PM' TO H-AM-PM
               IF  HRS = 12
                   MOVE HRS TO H-HRS
               ELSE
                   COMPUTE H-HRS = HRS - 12
               END-IF
           END-IF.

           MOVE DTH-SYSID TO H-SYSID.
           MOVE GL-H-CURR-PERIOD   TO H-PERIOD.
           MOVE GL-H-FISCAL-YEAR   TO H-FISCAL-YR.
           MOVE MONTH-NAME (GL-H-PER-END-MONTH) TO H-END-MONTH.
           MOVE GL-H-PER-END-DAY          TO H-END-DAY.
           MOVE GL-H-PER-END-YEAR  TO H-END-YR.
      /**************************************************************
       8030-COMPUTE-QUARTER-PRIOR88.
      ***************************************************************
           IF  GL-H-CURR-PERIOD <  4
               MOVE 0 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD =  13
               MOVE 4 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD <  7
               MOVE 1 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD <  10
               MOVE 2 TO CURR-QUARTER
           ELSE
               MOVE 3 TO CURR-QUARTER.
      /**************************************************************
       8035-COMPUTE-QUARTER-POST87.
      ***************************************************************
           IF  GL-H-CURR-PERIOD <  3
               MOVE 0 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD =  12
               MOVE 4 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD <  6
               MOVE 1 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD <  9
               MOVE 2 TO CURR-QUARTER
           ELSE
               MOVE 3 TO CURR-QUARTER.
      ***************************************************************
       8036-COMPUTE-QUARTER-PLANS.
      ***************************************************************
           IF  GL-H-CURR-PERIOD <  4
               MOVE 2 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD <  7
               MOVE 3 TO CURR-QUARTER
           ELSE
           IF  GL-H-CURR-PERIOD <  10
               MOVE 4 TO CURR-QUARTER
           ELSE
               MOVE 1 TO CURR-QUARTER.
      /**************************************************************
       8040-FORMAT-DTD-RECORD.
      ***************************************************************
           MOVE PERIOD-MNEMONIC (PER-MNEM-INDEX) TO PER-MNEM-WORK.
           MOVE PERIOD-MNEM-PER (PER-MNEM-INDEX) TO ALPHA-PERIOD.
           IF  PER-MNEM-1-2 =  'AA'
               PERFORM 8035-COMPUTE-QUARTER-POST87
               COMPUTE  WORK-QUARTER  =  CURR-QUARTER  -  NUM-PERIOD
               IF  WORK-QUARTER <  01
                   ADD  4  TO  WORK-QUARTER
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 106 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX)
               ELSE
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 17 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-1-2 =  'AQ'
               PERFORM 8035-COMPUTE-QUARTER-POST87
               COMPUTE  WORK-QUARTER  =  CURR-QUARTER  -  NUM-PERIOD
               IF  WORK-QUARTER <  01
                   ADD  4  TO  WORK-QUARTER
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 102 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX)
               ELSE
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 13 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-WORK = 'ACY'
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 110 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'AY1'
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 123 TO POINTER-INDEX.
           IF  PER-MNEM-1 =  'A'
               IF  PER-MNEM-2 IS  NUMERIC
                   COMPUTE  WORK-PERIOD = CURR-PERIOD  -  NUM-PERIOD
                   IF  WORK-PERIOD <  01
                       ADD  12  TO  WORK-PERIOD
                       MOVE WORK-PERIOD TO POINTER-INDEX
                       ADD 89 TO POINTER-INDEX
                       MOVE WORK-PERIOD TO
                                PERIOD-MNEM-PER (PER-MNEM-INDEX)
                   ELSE
                       MOVE WORK-PERIOD TO POINTER-INDEX
                       MOVE WORK-PERIOD TO
                                PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-WORK = 'D00'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 021 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'DCY'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 136 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'E00'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 038 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'ECY'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 149 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'F00'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 055 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'FCY'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 162 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'G00'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 072 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'GCY'
               MOVE CURR-PERIOD TO PERIOD-MNEM-PER (PER-MNEM-INDEX)
               MOVE CURR-PERIOD TO POINTER-INDEX
               ADD 175 TO POINTER-INDEX.
           IF  PER-MNEM-1-2 = 'AY' OR 'YA'
               IF  PER-MNEM-3 = '1'
                   MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
                   COMPUTE WORK-YEAR = DTH-FISCAL-YEAR - 1
                   MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX).
           IF  PER-MNEM-1-2 = 'AY'
               IF  PER-MNEM-3 = '2'
                   MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
                   COMPUTE WORK-YEAR = DTH-FISCAL-YEAR - 2
                   MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX).
           IF  PER-MNEM-1 = 'L' OR 'T'
               MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
               COMPUTE WORK-YEAR = DTH-FISCAL-YEAR - 1
               MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX).
           PERFORM 8050-CONTINUE-DTD-FORMAT.
      /**************************************************************
       8050-CONTINUE-DTD-FORMAT.
      ***************************************************************
           IF  PER-MNEM-1-2 =  'YQ'
               PERFORM 8036-COMPUTE-QUARTER-PLANS
               COMPUTE  WORK-QUARTER  =  CURR-QUARTER  +  NUM-PERIOD
               IF  WORK-QUARTER > 04
                   SUBTRACT  4  FROM  WORK-QUARTER
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 51 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX)
                   MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
                   COMPUTE WORK-YEAR = DTH-FISCAL-YEAR + 1
                   MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX)
               ELSE
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 51 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-1 =  'Y'
               IF  PER-MNEM-2 IS  NUMERIC
                   COMPUTE  WORK-PERIOD = CURR-PERIOD  +  NUM-PERIOD
                   IF  WORK-PERIOD >  12
                       SUBTRACT 12 FROM WORK-PERIOD
                       MOVE WORK-PERIOD TO POINTER-INDEX
                       ADD 38 TO POINTER-INDEX
                       MOVE WORK-PERIOD TO
                                PERIOD-MNEM-PER (PER-MNEM-INDEX)
                       MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
                    COMPUTE WORK-YEAR = DTH-FISCAL-YEAR + 1
                       MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX)
                   ELSE
                       MOVE WORK-PERIOD TO POINTER-INDEX
                       ADD 38 TO POINTER-INDEX
                       MOVE WORK-PERIOD TO
                                PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-1-2 =  'ZQ'
               PERFORM 8036-COMPUTE-QUARTER-PLANS
               COMPUTE  WORK-QUARTER  =  CURR-QUARTER  +  NUM-PERIOD
               IF  WORK-QUARTER > 04
                   SUBTRACT  4  FROM  WORK-QUARTER
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 68 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX)
                   MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
                   COMPUTE WORK-YEAR = DTH-FISCAL-YEAR + 1
                   MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX)
               ELSE
                   MOVE WORK-QUARTER TO POINTER-INDEX
                   ADD 68 TO POINTER-INDEX
                   MOVE WORK-QUARTER TO
                            PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-1 =  'Z'
               IF  PER-MNEM-2 IS  NUMERIC
                   COMPUTE  WORK-PERIOD = CURR-PERIOD  +  NUM-PERIOD
                   IF  WORK-PERIOD >  12
                       SUBTRACT 12 FROM WORK-PERIOD
                       MOVE WORK-PERIOD TO POINTER-INDEX
                       ADD 55 TO POINTER-INDEX
                       MOVE WORK-PERIOD TO
                                PERIOD-MNEM-PER (PER-MNEM-INDEX)
                       MOVE APOSTROPHE TO APOSTROPHE-X (PER-MNEM-INDEX)
                    COMPUTE WORK-YEAR = DTH-FISCAL-YEAR + 1
                       MOVE WORK-YEAR TO YEAR-MNEM-YR (PER-MNEM-INDEX)
                   ELSE
                       MOVE WORK-PERIOD TO POINTER-INDEX
                       ADD 55 TO POINTER-INDEX
                       MOVE WORK-PERIOD TO
                                PERIOD-MNEM-PER (PER-MNEM-INDEX).
           IF  PER-MNEM-WORK = 'YA0'
                   MOVE 162 TO POINTER-INDEX.
           IF  PER-MNEM-WORK = 'YA1'
                   MOVE 163 TO POINTER-INDEX.
           MOVE PERIOD-MNEM-POINTER (POINTER-INDEX)
                      TO   MNEMONIC-INDEX.
           IF  PERIOD-MNEM-REL-FLAG (PER-MNEM-INDEX) = 'X'
               MOVE PERIOD-MNEM-CALC-PARMS (MNEMONIC-INDEX)
                   TO PERIOD-MNEM-CALC-PARMS (PER-MNEM-INDEX).
           IF  PER-MNEM-WORK = 'YA0' OR 'YA1'
               MOVE CURR-PERIOD TO
                   PERIOD-MNEM-DIVISOR (PER-MNEM-INDEX).
           MOVE PERIOD-MNEM-RECORD (PER-MNEM-INDEX)
                      TO   WORK-RECORD.
           MOVE WORK-PERIOD-MNEMONIC    TO DTD-PERIOD-MNEMONIC.
           MOVE WORK-DEFAULT-HEADING-1  TO DTD-DEFAULT-HEADING-1.
           MOVE WORK-DEFAULT-HEADING-2  TO DTD-DEFAULT-HEADING-2.
           MOVE WORK-AVG-FLAG           TO DTD-AVG-FLAG.
           MOVE WORK-FCST-FLAG          TO DTD-FCST-FLAG.
           MOVE WORK-BEG-INDEX          TO DTD-BEG-INDEX.
           MOVE WORK-END-INDEX          TO DTD-END-INDEX.
           MOVE WORK-NO-REPS            TO DTD-NO-REPS.
           MOVE WORK-DIVISOR            TO DTD-DIVISOR.
           MOVE WORK-BAL-INDEX          TO DTD-BAL-INDEX.
           WRITE FD-DATE-FILE-REC       FROM  DTD-RECORD.
           ADD 1 TO DTF-COUNT.
      /**************************************************************
       9000-EDIT-REPORT-DEFINITIONS.
      ***************************************************************
           MOVE ZERO TO PAGE-COUNT.
           MOVE SPACES TO SAVE-REPORT-ID.
           PERFORM 9010-EDIT-REPORT-ENTRIES
               VARYING REPORT-INDEX FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                            =    HIGH-VALUES.
      ******************************************************************
       9010-EDIT-REPORT-ENTRIES.
      ******************************************************************
           MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.
           MOVE ZERO TO REPORT-ORG-COUNT.
           MOVE ZERO TO REPORT-REG-COUNT.
           MOVE ZERO TO REPORT-PRIME-COUNT.
           PERFORM 9150-PRINT-REPORT-HEADING.
           PERFORM 9020-CHECK-TABLE-IDS.
           PERFORM 9030-CHECK-REPORT-ROLLUPS.
           MOVE RDF-DOLLAR-FLAG TO RP1-DOLLAR-FLAG.

           MOVE ' REPORT'                 TO W0003-LINE-TYPE-DESC
           MOVE REPORT-PERIOD-DATA-LINE-1 TO W0003-DETAIL-DATA

           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-1
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-2
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-3
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE LOW-VALUES TO RDF-PM-INDEXES.
           PERFORM 9100-CHECK-PERIOD-MNEMONICS
               VARYING RDF-PERIOD-INDEX FROM 1 BY 1
               UNTIL  RDF-PERIOD-INDEX  >  MAX-PRINTABLE-COL.
           IF  RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX) NOT = SPACE
               PERFORM 9015-PRINT-CALC-COL-ENTRIES.
           MOVE RDF-RECORD TO REPORT-TABLE-ENTRY (REPORT-INDEX).
           IF  REPORT-ORG-COUNT =  ZERO
               MOVE ERRMSG-NO-ORG-SPECIFIED TO RP4-ERROR-MSG
               PERFORM 9160-WRITE-REPORT-ERROR.
           IF  REPORT-REG-COUNT =  ZERO
               MOVE ERRMSG-NO-REG-SPECIFIED TO RP4-ERROR-MSG
               PERFORM 9160-WRITE-REPORT-ERROR.
           IF  REPORT-PRIME-COUNT =  ZERO
               MOVE ERRMSG-NO-PRIME-SPECIFIED TO RP4-ERROR-MSG
               PERFORM 9160-WRITE-REPORT-ERROR.
           IF  REPORT-ORG-COUNT >  1
               MOVE ERRMSG-MULT-ORG-SPECIFIED TO RP4-ERROR-MSG
               PERFORM 9160-WRITE-REPORT-ERROR.
           IF  REPORT-REG-COUNT >  1
               MOVE ERRMSG-MULT-REG-SPECIFIED TO RP4-ERROR-MSG
               PERFORM 9160-WRITE-REPORT-ERROR.
           IF  REPORT-PRIME-COUNT >  1
               MOVE ERRMSG-MULT-PRIME-SPECIFIED TO RP4-ERROR-MSG
               PERFORM 9160-WRITE-REPORT-ERROR.
      ******************************************************************
       9015-PRINT-CALC-COL-ENTRIES.
      ******************************************************************
           PERFORM 9155-PRINT-REPORT-U-HEADING.
           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-1-U
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-2
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-3
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           PERFORM 9100-CHECK-PERIOD-MNEMONICS
               VARYING RDF-PERIOD-INDEX FROM RDF-PERIOD-INDEX BY 1
               UNTIL  RDF-PERIOD-INDEX  >  MAX-COL.
      /*****************************************************************
       9020-CHECK-TABLE-IDS.
      ******************************************************************
           MOVE 'LINE TABLE IDENTIFIER   :' TO RD1-LINE-LITERAL.
           MOVE RDF-LINE-ID TO LINE-ID-WORK-NUM.
           MOVE LINE-ID-WORK TO RD1-FIELD.
           SET LINE-INDEX TO 1.
           SEARCH LINE-ID-TABLE
               AT END
                   MOVE ERRMSG-UNDEFINED-LINE-ID TO RD1-ERROR-MSG
                   PERFORM 9990-SET-ERROR
               WHEN LINE-ID-WORK  =  LINE-TBL-ID (LINE-INDEX)
                   SET RDF-LINE-ID-INDEX TO LINE-INDEX.
           IF  LINE-TBL-TYPE (LINE-INDEX) =  'P'
               ADD 1 TO REPORT-PRIME-COUNT
           ELSE
           IF  LINE-TBL-TYPE (LINE-INDEX) =  'R'
               ADD 1 TO REPORT-REG-COUNT
           ELSE
           IF  LINE-TBL-TYPE (LINE-INDEX) =  'O'
               ADD 1 TO REPORT-ORG-COUNT.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO REPORT-DETAIL-LINE-1.
           MOVE 'COLUMN TABLE IDENTIFIER   :' TO RD1-LINE-LITERAL.
           MOVE RDF-COLUMN-ID TO COL-ID-WORK-NUM.
           MOVE COL-ID-WORK TO RD1-FIELD.
           SET COL-INDEX TO 1.
           SEARCH COL-ID-TABLE
               AT END
                   MOVE ERRMSG-UNDEFINED-COL-ID TO RD1-ERROR-MSG
                   PERFORM 9990-SET-ERROR
               WHEN COL-ID-WORK  =  COL-TBL-ID (COL-INDEX)
                   SET RDF-COLUMN-ID-INDEX TO COL-INDEX.
           IF  COL-TBL-TYPE (COL-INDEX) =  'P'
               ADD 1 TO REPORT-PRIME-COUNT
           ELSE
           IF  COL-TBL-TYPE (COL-INDEX) =  'R'
               ADD 1 TO REPORT-REG-COUNT
           ELSE
           IF  COL-TBL-TYPE (COL-INDEX) =  'O'
               ADD 1 TO REPORT-ORG-COUNT.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO REPORT-DETAIL-LINE-1.
           PERFORM 9025-CONTINUE-ID-CHECK.
      /*****************************************************************
       9025-CONTINUE-ID-CHECK.
      ******************************************************************
           MOVE 'ORGANIZATION TABLE ID     :' TO RD1-LINE-LITERAL.
           MOVE RDF-ORG-ID TO RD1-FIELD.
           IF  RDF-ORG-ID-INDEX =  ZERO
               MOVE ERRMSG-UNDEFINED-ORG TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO REPORT-DETAIL-LINE-1.
           MOVE 'REGION TABLE IDENTIFIER   :' TO RD1-LINE-LITERAL.
           MOVE RDF-REG-ID TO RD1-FIELD.
           IF  RDF-REG-ID-INDEX =  ZERO
               MOVE ERRMSG-UNDEFINED-REG TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO REPORT-DETAIL-LINE-1.
      /*****************************************************************
       9030-CHECK-REPORT-ROLLUPS.
      ******************************************************************
           MOVE SPACES TO REPORT-DETAIL-LINE-1.
           MOVE SPACES TO RR1-RUP1-TYPE.
           IF  RDF-RUP1-TYPE =  'O'
               MOVE 'ORGANIZATION' TO RR1-RUP1-TYPE
               ADD 1 TO REPORT-ORG-COUNT
           ELSE
           IF  RDF-RUP1-TYPE =  'R'
               MOVE 'REGION' TO RR1-RUP1-TYPE
               ADD 1 TO REPORT-REG-COUNT
           ELSE
           IF  RDF-RUP1-TYPE =  'P'
               MOVE 'PRIME' TO RR1-RUP1-TYPE
               ADD 1 TO REPORT-PRIME-COUNT
           ELSE
               MOVE RDF-RUP1-TYPE TO RR1-RUP1-TYPE
               MOVE ERRMSG-INVALID-RUP-TYPE TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           MOVE SPACES TO RR1-RUP2-TYPE.
           IF  RDF-RUP2-TYPE =  'O'
               MOVE 'ORGANIZATION' TO RR1-RUP2-TYPE
               ADD 1 TO REPORT-ORG-COUNT
           ELSE
           IF  RDF-RUP2-TYPE =  'R'
               MOVE 'REGION' TO RR1-RUP2-TYPE
               ADD 1 TO REPORT-REG-COUNT
           ELSE
           IF  RDF-RUP2-TYPE =  'P'
               MOVE 'PRIME' TO RR1-RUP2-TYPE
               ADD 1 TO REPORT-PRIME-COUNT
           ELSE
           IF  RDF-RUP2-TYPE NOT =  SPACE
               MOVE RDF-RUP2-TYPE TO RR1-RUP2-TYPE
               MOVE ERRMSG-INVALID-RUP-TYPE TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           PERFORM 9033-PRINT-REPORT-DETAIL-LINES.
      /*************************************************************
       9033-PRINT-REPORT-DETAIL-LINES.
      **************************************************************
           WRITE FD-PRINTER-REC  FROM  REPORT-RUP-LINE-1
               AFTER ADVANCING 2 LINES.

      *   REPORT-DETAIL-LINE IS PRINTED - ERROR MESSAGE OR BLANKS

           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-RUP-LINE-2
               AFTER ADVANCING 1 LINES.
           MOVE RDF-RUP1-MNEMONICS TO RUP-MNEMONICS.
           MOVE RDF-RUP1-TYPE TO RUP-TYPE.
           MOVE RUP-MNEMONIC (1) TO RR3-RUP1-LEVEL(1).
           MOVE RUP-MNEMONIC (2) TO RR3-RUP1-LEVEL(2).
           MOVE RUP-MNEMONIC (3) TO RR3-RUP1-LEVEL(3).
           MOVE RUP-MNEMONIC (4) TO RR3-RUP1-LEVEL(4).
           MOVE RUP-MNEMONIC (5) TO RR3-RUP1-LEVEL(5).
           MOVE RUP-MNEMONIC (6) TO RR3-RUP1-LEVEL(6).
           MOVE RUP-MNEMONIC (7) TO RR3-RUP1-LEVEL(7).
           MOVE RUP-MNEMONIC (8) TO RR3-RUP1-LEVEL(8).
           MOVE RUP-MNEMONIC (9) TO RR3-RUP1-LEVEL(9).
           MOVE RUP-MNEMONIC (10) TO RR3-RUP1-LEVEL(10).
           MOVE RUP-MNEMONIC (11) TO RR3-RUP1-LEVEL(11).
           MOVE SPACES TO HOLD-REPORT-ERROR-MSG.
           PERFORM 9035-CHECK-RUP-TYPE.
           MOVE RUP-MNEMONIC-INDEXES TO RDF-RUP1-INDEXES.
           MOVE HOLD-REPORT-ERROR-MSG TO RR4-RUP1-ERROR-MSG.
           MOVE RDF-RUP2-MNEMONICS TO RUP-MNEMONICS.
           MOVE RDF-RUP2-TYPE TO RUP-TYPE.
           MOVE RUP-MNEMONIC (1) TO RR3-RUP2-LEVEL(1).
           MOVE RUP-MNEMONIC (2) TO RR3-RUP2-LEVEL(2).
           MOVE RUP-MNEMONIC (3) TO RR3-RUP2-LEVEL(3).
           MOVE RUP-MNEMONIC (4) TO RR3-RUP2-LEVEL(4).
           MOVE RUP-MNEMONIC (5) TO RR3-RUP2-LEVEL(5).
           MOVE RUP-MNEMONIC (6) TO RR3-RUP2-LEVEL(6).
           MOVE RUP-MNEMONIC (7) TO RR3-RUP2-LEVEL(7).
           MOVE RUP-MNEMONIC (8) TO RR3-RUP2-LEVEL(8).
           MOVE RUP-MNEMONIC (9) TO RR3-RUP2-LEVEL(9).
           MOVE RUP-MNEMONIC (10) TO RR3-RUP2-LEVEL(10).
           MOVE RUP-MNEMONIC (11) TO RR3-RUP2-LEVEL(11).
           MOVE SPACES TO HOLD-REPORT-ERROR-MSG.
           PERFORM 9035-CHECK-RUP-TYPE.
           MOVE RUP-MNEMONIC-INDEXES TO RDF-RUP2-INDEXES.
           MOVE HOLD-REPORT-ERROR-MSG TO RR4-RUP2-ERROR-MSG.
           WRITE FD-PRINTER-REC  FROM  REPORT-RUP-LINE-3
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-RUP-LINE-4
               AFTER ADVANCING 2 LINES.
           MOVE SPACES TO REPORT-RUP-LINE-4.
           IF  RDF-ELIM-SUPP-FLAG NOT =  SPACE
               MOVE RPT-ELIM-SUPP-MSG TO RR4-RUP1-ERROR-MSG.
           IF  RDF-COL-CALC-FLAG NOT =  SPACE
               MOVE RPT-COL-CALC-MSG TO RR4-RUP2-ERROR-MSG.
           WRITE FD-PRINTER-REC  FROM  REPORT-RUP-LINE-4
               AFTER ADVANCING 2 LINES.
      /*****************************************************************
       9035-CHECK-RUP-TYPE.
      ******************************************************************
           MOVE LOW-VALUES TO RUP-MNEMONIC-INDEXES.
           IF  RUP-TYPE =  'O'
              PERFORM 9050-CHECK-ORG-ROLLUP
           ELSE
           IF  RUP-TYPE =  'R'
              PERFORM 9070-CHECK-REG-ROLLUP
           ELSE
           IF  RUP-TYPE =  'P'
               PERFORM 9040-CHECK-PRIME-ROLLUP
                   VARYING RUP-INDEX FROM 1 BY 1
                   UNTIL  RUP-INDEX  >  MAX-PRIME-RUP-LEVELS
                      OR  RUP-MNEMONIC (RUP-INDEX)  =  SPACES.
      /*****************************************************************
       9040-CHECK-PRIME-ROLLUP.
      ******************************************************************
           SEARCH ALL PRIME-ID-TABLE-ENTRIES
               AT END
                   MOVE ERRMSG-UNDEFINED-RPT-PRIME
                              TO HOLD-REPORT-ERROR-MSG
                   PERFORM 9990-SET-ERROR
               WHEN    PRIME-SRT-ID (PRIME-SRT-INDEX)
                           =  RUP-MNEMONIC (RUP-INDEX)
                   MOVE PRIME-SRT-ENTRY-INDEX (PRIME-SRT-INDEX)
                       TO RUP-MNEMONIC-INDEX (RUP-INDEX)
                   SET PRIME-INDEX TO
                       PRIME-SRT-ENTRY-INDEX (PRIME-SRT-INDEX)
                   MOVE 'Y' TO PRIME-TBL-USAGE-FLAG (PRIME-INDEX).
      /*****************************************************************
       9050-CHECK-ORG-ROLLUP.
      ******************************************************************
           IF  RDF-ORG-ID-INDEX NOT =  ZERO
               MOVE RDF-ORG-ID-INDEX TO ORG-ID-INDEX
               MOVE ORG-TABLE-ENTRY-1 (ORG-ID-INDEX, 1)
                     TO  ORG-HEADER-1
               MOVE ORG-TABLE-ENTRY-2 (ORG-ID-INDEX, 1)
                     TO  ORG-HEADER-2
               PERFORM 9060-CHECK-ORG-RUPS
                   VARYING RUP-INDEX FROM 1 BY 1
                       UNTIL  RUP-INDEX  >  MAX-RUP-LEVELS
                          OR  RUP-MNEMONIC (RUP-INDEX)  =  SPACES.
      ******************************************************************
       9060-CHECK-ORG-RUPS.
      ******************************************************************
           PERFORM 9065-CHECK-ORG-HEADER-MNEMS
               VARYING ORG-WORK-SUB FROM 1 BY 1
                   UNTIL  ORG-WORK-SUB  >  MAX-ORG-LVLS
                   OR  RUP-MNEMONIC-INDEX (RUP-INDEX)  NOT =  ZERO.
           IF  RUP-MNEMONIC-INDEX (RUP-INDEX) =  ZERO
               MOVE ERRMSG-UNDEFINED-RUP TO HOLD-REPORT-ERROR-MSG
               PERFORM 9990-SET-ERROR.
      ******************************************************************
       9065-CHECK-ORG-HEADER-MNEMS.
      ******************************************************************
           IF  RUP-MNEMONIC (RUP-INDEX) =
                         ORG-HDR-LEVEL (ORG-WORK-SUB)
               MOVE ORG-WORK-SUB TO RUP-MNEMONIC-INDEX (RUP-INDEX).
      /*****************************************************************
       9070-CHECK-REG-ROLLUP.
      ******************************************************************
           IF  RDF-REG-ID-INDEX NOT =  ZERO
               SET REG-ID-INDEX TO RDF-REG-ID-INDEX
               MOVE REG-TABLE-ENTRY (REG-ID-INDEX, 1)
                     TO  REG-HEADER-WORK-AREA
               PERFORM 9080-CHECK-REG-RUPS
                   VARYING RUP-INDEX FROM 1 BY 1
                       UNTIL  RUP-INDEX  >  MAX-RUP-LEVELS
                          OR  RUP-MNEMONIC (RUP-INDEX)  =  SPACES.
      ******************************************************************
       9080-CHECK-REG-RUPS.
      ******************************************************************
           PERFORM 9085-CHECK-REG-HEADER-MNEMS
               VARYING REG-WORK-SUB FROM 1 BY 1
                   UNTIL  REG-WORK-SUB  >  MAX-REG-LVLS
                   OR  RUP-MNEMONIC-INDEX (RUP-INDEX)  NOT =  ZERO.
           IF  RUP-MNEMONIC-INDEX (RUP-INDEX) =  ZERO
               MOVE ERRMSG-UNDEFINED-RUP TO HOLD-REPORT-ERROR-MSG
               PERFORM 9990-SET-ERROR.
      ******************************************************************
       9085-CHECK-REG-HEADER-MNEMS.
      ******************************************************************
           IF  RUP-MNEMONIC (RUP-INDEX) =
                         REG-HDR-LEVEL (REG-WORK-SUB)
               MOVE REG-WORK-SUB TO RUP-MNEMONIC-INDEX (RUP-INDEX).
      /*****************************************************************
       9100-CHECK-PERIOD-MNEMONICS.
      ******************************************************************
           MOVE SPACES TO REPORT-PERIOD-DATA-LINE-4.
           MOVE RDF-PERIOD-INDEX TO RP4-COL-NUMBER.
           MOVE RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX)
               TO RP4-MNEMONIC.
           IF  RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX) NOT =  SPACES
               SEARCH ALL PERIOD-MNEMONIC-RECORD
                   AT END
                       MOVE ERRMSG-UNDEFINED-PERIOD-MNEM TO
                                     RP4-ERROR-MSG
                       PERFORM 9990-SET-ERROR
                   WHEN  PERIOD-MNEMONIC (PER-MNEM-INDEX)   =
                         RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX)
                       MOVE PERIOD-MNEMONIC-HDG (PER-MNEM-INDEX)
                           TO RP4-DESCRIPTION
                       SET RDF-PM-INDEX (RDF-PERIOD-INDEX)
                           TO PER-MNEM-INDEX.
           IF  RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX) NOT =  SPACES
               IF  COL-WORK-TABLE-FLAG
                 (RDF-COLUMN-ID-INDEX, RDF-PERIOD-INDEX)  =  SPACES
                   MOVE ERRMSG-NO-COL-FOR-PERIOD-DATA TO
                                     RP4-ERROR-MSG
                   PERFORM 9990-SET-ERROR
               ELSE
                   NEXT SENTENCE
           ELSE
               IF  COL-WORK-TABLE-FLAG
                   (RDF-COLUMN-ID-INDEX, RDF-PERIOD-INDEX)  =  'D'
                   MOVE ERRMSG-NO-PERIOD-DATA-FOR-COL TO
                                 RP4-ERROR-MSG
                   PERFORM 9990-SET-ERROR.
           IF  RDF-PERIOD-INDEX NOT > MAX-PRINTABLE-COL
               IF  COL-WORK-TABLE-FLAG
                  (RDF-COLUMN-ID-INDEX, RDF-PERIOD-INDEX)
                         NOT = SPACE
                   IF  (RDF-FORMAT-TYPE = 'A' OR 'B' OR 'C')
                   AND RDF-PERIOD-INDEX > 11
                       MOVE ERRMSG-TOO-MANY-COLUMNS TO RP4-ERROR-MSG
                       PERFORM 9990-SET-ERROR
                   ELSE
                   IF  RDF-FORMAT-TYPE = 'D'
                   AND RDF-PERIOD-INDEX > 12
                       MOVE ERRMSG-TOO-MANY-COLUMNS TO RP4-ERROR-MSG
                       PERFORM 9990-SET-ERROR
                   ELSE
                   IF  RDF-FORMAT-TYPE = 'E'
                   AND RDF-PERIOD-INDEX > 9
                       MOVE ERRMSG-TOO-MANY-COLUMNS TO RP4-ERROR-MSG
                       PERFORM 9990-SET-ERROR
                   ELSE
                   IF  RDF-FORMAT-TYPE = 'G'
                   AND RDF-PERIOD-INDEX > 8
                       MOVE ERRMSG-TOO-MANY-COLUMNS TO RP4-ERROR-MSG
                       PERFORM 9990-SET-ERROR.
           IF  RDF-PERIOD-MNEMONIC (RDF-PERIOD-INDEX) NOT =  SPACES
           OR RDF-PERIOD-INDEX NOT > MAX-PRINTABLE-COL
               WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-4
                   AFTER ADVANCING 1 LINES.
      /*****************************************************************
       9150-PRINT-REPORT-HEADING.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE REPORT-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-1
               AFTER ADVANCING 3 LINES.
           MOVE SPACES TO REPORT-TITLE-LINE-2.
           MOVE RDF-TITLE-1 TO RT2-TITLE.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 2 LINES.
           MOVE RDF-TITLE-2 TO RT2-TITLE.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 1 LINES.
           MOVE RDF-TITLE-3 TO RT2-AREA.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 2 LINES.
           MOVE 'REPORT IDENTIFIER :' TO RD1-LINE-LITERAL.
           MOVE RDF-REPORT-ID TO RD1-FIELD.
           IF  RDF-REPORT-ID =  SAVE-REPORT-ID
               MOVE ERRMSG-DUP-REPORT-ID TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           IF  RDF-ORG-ID =  HIGH-VALUES
               MOVE ERRMSG-UNDEFINED-REPORT-ID TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           MOVE RDF-REPORT-ID TO SAVE-REPORT-ID.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 3 LINES.
           MOVE 'PAGE BREAK LEVEL  :' TO RD1-LINE-LITERAL.
           MOVE RDF-PAGE-BREAK TO RD1-FIELD.
           IF  RDF-PAGE-BREAK =  ' '  OR  '1'  OR  '2'
                NEXT SENTENCE
           ELSE
               MOVE ERRMSG-INVALID-PAGE-BREAK TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 2 LINES.
           MOVE 'REPORT FORMAT     :' TO RD1-LINE-LITERAL.
           MOVE RDF-FORMAT-TYPE TO RD1-FIELD.
           IF  RDF-FORMAT-TYPE = 'A' OR 'B' OR 'C' OR 'D'
                             OR 'E' OR 'F' OR 'G' OR 'L'
                NEXT SENTENCE
           ELSE
               MOVE ERRMSG-INVALID-REPORT-FORMAT TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 2 LINES.
      /*****************************************************************
       9155-PRINT-REPORT-U-HEADING.
      ******************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC  FROM  HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE REPORT-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC  FROM  HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-1
               AFTER ADVANCING 3 LINES.
           MOVE SPACES TO REPORT-TITLE-LINE-2.
           MOVE RDF-TITLE-1 TO RT2-TITLE.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 2 LINES.
           MOVE RDF-TITLE-2 TO RT2-TITLE.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 1 LINES.
           MOVE RDF-TITLE-3 TO RT2-AREA.
           WRITE FD-PRINTER-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 2 LINES.
           MOVE 'REPORT IDENTIFIER :' TO RD1-LINE-LITERAL.
           MOVE RDF-REPORT-ID TO RD1-FIELD.
           IF  RDF-ORG-ID =  HIGH-VALUES
               MOVE ERRMSG-UNDEFINED-REPORT-ID TO RD1-ERROR-MSG
               PERFORM 9990-SET-ERROR.
           MOVE RDF-REPORT-ID TO SAVE-REPORT-ID.
           WRITE FD-PRINTER-REC  FROM  REPORT-DETAIL-LINE-1
               AFTER ADVANCING 3 LINES.
      /*****************************************************************
       9160-WRITE-REPORT-ERROR.
      ******************************************************************
           WRITE FD-ERRORS-REC  FROM  REPORT-TITLE-LINE-2
               AFTER ADVANCING 1 LINES.

           WRITE FD-PRINTER-REC  FROM  REPORT-PERIOD-DATA-LINE-4.
           MOVE SPACES TO REPORT-PERIOD-DATA-LINE-4.
           ADD 1 TO LINE-COUNT.
           ADD 1 TO ERROR-COUNT.
           MOVE 'Y' TO MASTER-ERROR-SWITCH.
      *    MOVE 12 TO RETURN-CODE.

           WRITE FD-ERRORS-REC  FROM  FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE ALL '-' TO FD-ERROR-AREA.
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.
      /**************************************************************
       9990-SET-ERROR.
      ***************************************************************
           ADD 1 TO ERROR-COUNT.
           MOVE 'Y' TO MASTER-ERROR-SWITCH.
      *    MOVE 12 TO RETURN-CODE.
      ***************************************************************
       9999-WRITE-PRINTER.
      ***************************************************************
           WRITE FD-ERRORS-REC  FROM  W0003-LINE-TYPE
               AFTER ADVANCING 1 LINES.
           WRITE FD-ERRORS-REC  FROM  W0003-DETAIL-LINE
               AFTER ADVANCING 1 LINES.

           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           ADD 1 TO LINE-COUNT.
           ADD 1 TO ERROR-COUNT.
           MOVE 'Y' TO MASTER-ERROR-SWITCH.
      *    MOVE 12 TO RETURN-CODE.               WRITE FD-ERRORS-REC  FROM  FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.

           MOVE ALL '-' TO FD-ERROR-AREA.
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.

      /**************************************************************
       10000-EDIT-BOOK-DEFINITIONS.
      ***************************************************************
      *    COMMENTS :  READ THRU THE EXTERNAL BOOK FILE AGAIN,
      *       TO PICK UP RECORD TYPE '3' (FOR THE REPORT IDS)
      *       AND TO PICK UP RECORD TYPE '4' (TO DETERMINE THE
      *       PAGE BREAK LEVELS DESIRED..RUP1/RUP2).  ONCE THESE
      *       ARE EDITED, RECORDS OF TYPE '5' (WHICH CAN BE MULTIPLE)
      *       ARE EXPLODED INTO THE ACTUAL KEY COMBINATIONS THAT
      *       WILL HAVE A PAGE PRINTED FOR THEM.  OF COURSE, THIS
      *       WILL BE REPEATED FOR EACH BOOK DEFINITION.
      ******************************************************************
      ***************************************************************
           OPEN INPUT  IN-BOOK-FILE
                OUTPUT PRINTER2
                OUTPUT EXP-BOOK-DEF-FILE
                OUTPUT TBL-OF-CONT-FILE.
           MOVE ZERO TO PAGE-COUNT.
           MOVE SPACES TO BOOK-EXISTENCE-FLAGS.
           MOVE SPACES TO RUP-LIT-MOVED-FLAGS.
           MOVE SPACES TO SAVE-BOOK-REC5.
           MOVE SPACES TO IN-BOOK-FILE-STATUS.
           MOVE SPACES TO SAVE-BOOK-ID.
           PERFORM 10010-READ-IN-BOOK-FILE.
           MOVE 'Y' TO READ-BOOK-FLAG.
           PERFORM 10015-CHECK-AND-READ-BOOK-RECS
               UNTIL  END-OF-BOOK-FILE.
           CLOSE IN-BOOK-FILE
                 EXP-BOOK-DEF-FILE
                 TBL-OF-CONT-FILE.
      ******************************************************************
       10010-READ-IN-BOOK-FILE.
      ******************************************************************
           PERFORM 10015-READ-IN-BOOK-FILE.
           PERFORM 10015-READ-IN-BOOK-FILE UNTIL
               (IN-BOOK-ID-1 IS NOT = '/') OR
                   END-OF-BOOK-FILE.
      ******************************************************************
       10015-READ-IN-BOOK-FILE.
      ******************************************************************
           READ IN-BOOK-FILE  INTO  IN-BOOK-REC
               AT END
                   MOVE 'EOF' TO IN-BOOK-FILE-STATUS.
      ******************************************************************
       10015-CHECK-AND-READ-BOOK-RECS.
      ******************************************************************
           PERFORM 10020-CHECK-BOOK-REC-TYPES.
           IF  READ-BOOK-FLAG =  'Y'
               PERFORM 10010-READ-IN-BOOK-FILE
           ELSE
               MOVE 'Y' TO READ-BOOK-FLAG.
      /*****************************************************************
       10020-CHECK-BOOK-REC-TYPES.
      ******************************************************************
           IF  IN-BOOK-ID NOT =  SAVE-BOOK-ID
               ADD 1 TO BOOK-COUNT
               MOVE 'N' TO BOOK-ONES-FLAG
               MOVE 'N' TO BOOK-REC-TYPE-FLAG
               PERFORM 10025-SEARCH-FOR-BOOK-ID
           ELSE
           IF  IN-BOOK-REC-TYPE =  '1'
               PERFORM 10520-FORMAT-LINE-1
               PERFORM 10027-WRITE-TCM-RECORD
           ELSE
           IF  IN-BOOK-REC-TYPE =  '2'
               PERFORM 10530-FORMAT-LINE-2
               PERFORM 10029-WRITE-TCM-REC-2
           ELSE
           IF  IN-BOOK-REC-TYPE =  '3'
               PERFORM 10540-FORMAT-LINE-3
               MOVE 'N' TO BOOK-RPT-ERROR-SWITCH
               MOVE SPACES TO BOOK-ORG-ID  BOOK-REG-ID
                      BOOK-RUP1-TYPE BOOK-RUP2-TYPE
               MOVE IN-BOOK-PRINT-SUPP-FLAG TO PRINT-SUPP-FLAG
               MOVE LOW-VALUES TO WORK-RPT-TABLE
               PERFORM 10030-COMPARE-BOOK-REPORTS
                   VARYING BOOK-REPORT-INDEX FROM 1 BY 1
                   UNTIL  BOOK-REPORT-INDEX  >  MAX-RPTS-ON-BOOK
                      OR  IN-BOOK-REPORT-ID (BOOK-REPORT-INDEX)
                                 =  SPACES
           ELSE
           IF  IN-BOOK-REC-TYPE =  '4'
               PERFORM 10550-FORMAT-LINE-4
               IF  BOOK-RPT-ERROR-SWITCH =  'N'
                   PERFORM 10050-CONVERT-BOOK-MNEMONICS
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  IN-BOOK-REC-TYPE =  '5'
               PERFORM 10560-FORMAT-LINE-5
               IF  BOOK-RPT-ERROR-SWITCH =  'N'
                   PERFORM 10060-SET-UP-EXB-TABLES
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  IN-BOOK-REC-TYPE =  '6'
               IF  BOOK-RPT-ERROR-SWITCH =  'N'
                   PERFORM 10400-PROCESS-REC6
                   MOVE 'N' TO READ-BOOK-FLAG
               ELSE
                   NEXT SENTENCE
           ELSE
               PERFORM 10570-FORMAT-ERROR-LINE.
           IF  IN-BOOK-REC-TYPE NOT =  '5'
               MOVE SPACES TO RUP-LIT-MOVED-FLAGS
               MOVE SPACES TO SAVE-BOOK-REC5.
           MOVE IN-BOOK-REC-TYPE TO LAST-BOOK-REC-TYPE.
           IF  IN-BOOK-REC-TYPE = '1'
               MOVE 'Y' TO BOOK-ONES-FLAG
           ELSE
               IF  BOOK-ONES-FLAG = 'Y'
                   MOVE 'Y' TO BOOK-REC-TYPE-FLAG.
           IF  IN-BOOK-REC-TYPE = '1' AND BOOK-REC-TYPE-FLAG = 'Y'
               MOVE ERRMSG-REC-TYPE-1 TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9990-SET-ERROR
               PERFORM 10600-WRITE-BOOK-LINE.
      /*****************************************************************
       10023-BYPASS-BOOK-ID.
      ******************************************************************
           MOVE IN-BOOK-ID TO SAVE-BOOK-ID.
           PERFORM 10010-READ-IN-BOOK-FILE
               UNTIL IN-BOOK-ID  NOT =  SAVE-BOOK-ID
                  OR END-OF-BOOK-FILE.
           MOVE 'N' TO READ-BOOK-FLAG.
      ******************************************************************
       10025-SEARCH-FOR-BOOK-ID.
      ******************************************************************
      *    DISPLAY '10025-SEARCH-FOR-BOOK-ID'.
           MOVE LOW-VALUES TO EXB-RECORD.
           SEARCH ALL BDX-TABLE-ENTRIES
               AT END
                   PERFORM 10023-BYPASS-BOOK-ID
               WHEN  BDX-TBL-BOOK-ID (BDX-INDEX)  =  IN-BOOK-ID
                   PERFORM 10026-NEW-BOOK.
      ******************************************************************
       10026-NEW-BOOK.
      ******************************************************************
           MOVE IN-BOOK-ID TO SAVE-BOOK-ID.
           MOVE IN-BOOK-TOC-GEN-FLAG TO GEN-TOC-FLAG.
           MOVE 'M' TO BOOK-TITLE-FLAG.
           PERFORM 10950-PRINT-BOOK-HEADINGS.
           PERFORM 10650-PRINT-BOOK-HEADINGS.
           SET EXB-BOOK-ID-INDEX TO BDX-INDEX.
           IF  BOOK-EXISTS-FLAG (EXB-BOOK-ID-INDEX) =  SPACE
               MOVE 'Y' TO BOOK-EXISTS-FLAG (EXB-BOOK-ID-INDEX)
           ELSE
               MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
               MOVE ERRMSG-DOUBLE-BOOK TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE
               PERFORM 9990-SET-ERROR.
           MOVE EXB-BOOK-ID-INDEX TO TCM-BOOK-ID-INDEX.
           MOVE ZERO TO TCM-SEQUENCE-NO.
           MOVE ZERO TO EXB-BOOK-SEQUENCE-NO.
           MOVE 'N' TO READ-BOOK-FLAG.
      ******************************************************************
       10027-WRITE-TCM-RECORD.
      ******************************************************************
      *    DISPLAY '10027-WRITE-TCM-RECORD'.
           MOVE '1' TO TCM-RECORD-TYPE.
           ADD 1 TO EXB-BOOK-SEQUENCE-NO.
           MOVE EXB-BOOK-SEQUENCE-NO TO TCM-SEQUENCE-NO.
           MOVE IN-BOOK-TITLE-MEMO TO TCM-TEXT.
           WRITE FD-TBL-OF-CONT-FILE-REC FROM TCM-RECORD.
           ADD 1 TO TCM-COUNT.
           IF  BOOK-TITLE-FLAG NOT =  'M'
               MOVE 'M' TO BOOK-TITLE-FLAG
               PERFORM 10950-PRINT-BOOK-HEADINGS.
           MOVE IN-BOOK-TITLE-MEMO TO BD-MEMO-TEXT.
           MOVE BOOK-MEMO-LINE TO FD-PRINTER2-REC.
           PERFORM 10900-WRITE-BOOK-LINE.
      /*****************************************************************
       10029-WRITE-TCM-REC-2.
      ******************************************************************
      *    DISPLAY '10029-WRITE-TCM-REC-2'.
           MOVE '2' TO TCM-RECORD-TYPE.
           MOVE IN-BOOK-TOC-LINE TO TCM-TEXT.
           IF  IN-BOOK-PAGE-COUNT IS NUMERIC
               MOVE IN-BOOK-PAGE-COUNT TO TCM-MANUAL-PAGE-COUNT
           ELSE
               MOVE ZERO TO TCM-MANUAL-PAGE-COUNT.
           ADD 1 TO EXB-BOOK-SEQUENCE-NO.
           MOVE EXB-BOOK-SEQUENCE-NO TO TCM-SEQUENCE-NO.
           WRITE FD-TBL-OF-CONT-FILE-REC FROM TCM-RECORD.
           ADD 1 TO TCM-COUNT.
           IF  BOOK-TITLE-FLAG NOT =  'T'
               MOVE 'T' TO BOOK-TITLE-FLAG
               PERFORM 10950-PRINT-BOOK-HEADINGS.
           MOVE IN-BOOK-TOC-LINE TO BD-TOC-TEXT.
           MOVE BOOK-TOC-LINE TO FD-PRINTER2-REC.
           PERFORM 10900-WRITE-BOOK-LINE.
      /*****************************************************************
       10030-COMPARE-BOOK-REPORTS.
      ******************************************************************
      *  COMMENTS :
      ******************************************************************
      *    DISPLAY '10030-COMPARE-BOOK-REPORTS'.
           MOVE 'N' TO BOOK-RPT-FOUND-SWITCH.
           SEARCH ALL REPORT-TABLE-ENTRIES
               WHEN    RDT-REPORT-ID (REPORT-INDEX)
                    =  IN-BOOK-REPORT-ID (BOOK-REPORT-INDEX)
                   MOVE 'Y' TO BOOK-RPT-FOUND-SWITCH.
           IF  BOOK-RPT-FOUND-SWITCH =  'N'
               DISPLAY '@@ UNDEFINED REPORT IN BOOK @@ '
                       IN-BOOK-REPORT-ID (BOOK-REPORT-INDEX)
               MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
               MOVE ERRMSG-UNDEFINED-REPORT-ID TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE
               PERFORM 9990-SET-ERROR
           ELSE
               PERFORM 10040-BUILD-ORG-REG-RUP-TABLE.
      /*****************************************************************
       10040-BUILD-ORG-REG-RUP-TABLE.
      ******************************************************************
      *    DISPLAY '10040-BUILD-ORG-REP-RUP-TABLE'.
           MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.
           SET WORK-RPT-INDEX (BOOK-REPORT-INDEX) TO REPORT-INDEX.
           IF  BOOK-ORG-ID =  SPACES
               MOVE RDF-ORG-ID TO BOOK-ORG-ID
               MOVE RDF-ORG-ID-INDEX TO BOOK-ORG-ID-INDEX.
           IF  BOOK-REG-ID =  SPACES
               MOVE RDF-REG-ID TO BOOK-REG-ID
               MOVE RDF-REG-ID-INDEX TO BOOK-REG-ID-INDEX.
           IF  BOOK-RUP1-TYPE =  SPACES
               MOVE RDF-RUP1-TYPE TO BOOK-RUP1-TYPE
           ELSE
           IF  BOOK-RUP1-TYPE NOT =  RDF-RUP1-TYPE
               DISPLAY '@@ RUP1 TYPE CONFLICT IN BOOK @@ '
                   BOOK-RUP1-TYPE '  ' RDF-RUP1-TYPE
               MOVE ERRMSG-RUP-CONFLICT TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE
               PERFORM 9990-SET-ERROR
               MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
           ELSE
           IF  BOOK-RUP1-TYPE =  'O'
               IF  BOOK-ORG-ID NOT =  RDF-ORG-ID
                   DISPLAY '@@ RUP1 ORG ID CONFLICT IN BOOK @@ '
                      BOOK-ORG-ID '  ' RDF-ORG-ID
                   MOVE ERRMSG-ORG-CONFLICT TO BOOK-ERROR-MSG
                   MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 10600-WRITE-BOOK-LINE
                   PERFORM 9990-SET-ERROR
                   MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
               ELSE
                   NEXT SENTENCE
           ELSE
           IF  BOOK-RUP1-TYPE =  'R'
               IF  BOOK-REG-ID NOT =  RDF-REG-ID
                   DISPLAY '@@ RUP1 REG ID CONFLICT IN BOOK @@ '
                       BOOK-REG-ID '  ' RDF-REG-ID
                   MOVE ERRMSG-REG-CONFLICT TO BOOK-ERROR-MSG
                   MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 10600-WRITE-BOOK-LINE
                   PERFORM 9990-SET-ERROR
                   MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH.
           PERFORM 10045-CONTINUE-RUP-BUILD.
      /*****************************************************************
       10045-CONTINUE-RUP-BUILD.
      ******************************************************************
           IF  RDF-RUP2-TYPE NOT =  SPACES
               IF  BOOK-RUP2-TYPE =  SPACES
                   MOVE RDF-RUP2-TYPE TO BOOK-RUP2-TYPE
               ELSE
               IF  BOOK-RUP2-TYPE NOT =  RDF-RUP2-TYPE
               AND RDF-RUP2-TYPE  NOT =  SPACE
                   DISPLAY '@@ RUP2 TYPE CONFLICT IN BOOK @@ '
                       BOOK-RUP2-TYPE '  ' RDF-RUP2-TYPE
                   MOVE ERRMSG-RUP-CONFLICT TO BOOK-ERROR-MSG
                   MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 10600-WRITE-BOOK-LINE
                   PERFORM 9990-SET-ERROR
                   MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
               ELSE
               IF  BOOK-RUP2-TYPE =  'O'
                   IF  BOOK-ORG-ID NOT =  RDF-ORG-ID
                       DISPLAY '@@ RUP2 ORG ID CONFLICT IN BOOK @@'
                           BOOK-ORG-ID '  ' RDF-ORG-ID
                       MOVE ERRMSG-ORG-CONFLICT TO BOOK-ERROR-MSG
                       MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
                       PERFORM 10600-WRITE-BOOK-LINE
                       PERFORM 9990-SET-ERROR
                       MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
                   ELSE
                       NEXT SENTENCE
               ELSE
               IF  BOOK-RUP2-TYPE =  'R'
                   IF  BOOK-REG-ID NOT =  RDF-REG-ID
                       MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
                       MOVE ERRMSG-REG-CONFLICT TO BOOK-ERROR-MSG
                       MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
                       PERFORM 10600-WRITE-BOOK-LINE
                       PERFORM 9990-SET-ERROR
                       DISPLAY '@@ RUP2 REG ID CONFLICT IN BOOK @@ '
                          BOOK-REG-ID '  ' RDF-REG-ID.
      /*****************************************************************
       10050-CONVERT-BOOK-MNEMONICS.
      ******************************************************************
      *   COMMENTS :
      ******************************************************************
      *    DISPLAY '10050-CONVERT-BOOK-MNEMONICS'.
           IF  BOOK-RUP1-TYPE =  'P'
               MOVE IN-BOOK-PRIME-RUP1-MNEMS TO RUP-MNEMONICS
           ELSE
               PERFORM 10052-MOVE-RUP1-MNEMONICS
                   VARYING WORK-INDEX FROM 1 BY 1
                   UNTIL  WORK-INDEX  >  MAX-RUP-LEVELS.
           PERFORM 10055-CHECK-RDF-RUP1
               VARYING BOOK-REPORT-INDEX FROM 1 BY 1
               UNTIL  WORK-RPT-INDEX (BOOK-REPORT-INDEX)  =  ZERO.
           MOVE LOW-VALUES TO RUP-MNEMONIC-INDEXES.
           MOVE SPACES TO HOLD-REPORT-ERROR-MSG.
           IF  BOOK-RUP1-TYPE =  'P'
               PERFORM 9040-CHECK-PRIME-ROLLUP
                   VARYING RUP-INDEX FROM 1 BY 1
                   UNTIL  RUP-INDEX  >  MAX-PRIME-RUP-LEVELS
                      OR  RUP-MNEMONIC (RUP-INDEX)  =  SPACES
           ELSE
           IF  BOOK-RUP1-TYPE =  'O'
              PERFORM 9050-CHECK-ORG-ROLLUP
           ELSE
           IF  BOOK-RUP1-TYPE =  'R'
              PERFORM 9070-CHECK-REG-ROLLUP.
           MOVE RUP-MNEMONIC-INDEXES TO BOOK-RUP1-LEVELS.
           IF  HOLD-REPORT-ERROR-MSG NOT =  SPACES
               MOVE HOLD-REPORT-ERROR-MSG TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE.
           IF  RUP-MNEMONIC-INDEXES =  LOW-VALUES
               MOVE ERRMSG-INVALID-RUP TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9990-SET-ERROR
               PERFORM 10600-WRITE-BOOK-LINE.
           MOVE LOW-VALUES TO BOOK-RUP2-LEVELS.
           IF  BOOK-RUP2-TYPE NOT =  SPACE
               PERFORM 10051-CONVERT-RUP2-MNEMS.
      /*****************************************************************
       10051-CONVERT-RUP2-MNEMS.
      ******************************************************************
           IF  BOOK-RUP2-TYPE =  'P'
               MOVE IN-BOOK-PRIME-RUP2-MNEMS TO RUP-MNEMONICS
           ELSE
               PERFORM 10053-MOVE-RUP2-MNEMONICS
                   VARYING WORK-INDEX FROM 1 BY 1
                   UNTIL  WORK-INDEX  >  MAX-RUP-LEVELS.
           PERFORM 10056-CHECK-RDF-RUP2
               VARYING BOOK-REPORT-INDEX FROM 1 BY 1
               UNTIL  WORK-RPT-INDEX (BOOK-REPORT-INDEX)  =  ZERO.
           MOVE SPACES TO HOLD-REPORT-ERROR-MSG.
           MOVE LOW-VALUES TO RUP-MNEMONIC-INDEXES.
           IF  BOOK-RUP2-TYPE =  'P'
               PERFORM 9040-CHECK-PRIME-ROLLUP
                   VARYING RUP-INDEX FROM 1 BY 1
                   UNTIL  RUP-INDEX  >  MAX-PRIME-RUP-LEVELS
                      OR  RUP-MNEMONIC (RUP-INDEX)  =  SPACES
           ELSE
           IF  BOOK-RUP2-TYPE =  'O'
              PERFORM 9050-CHECK-ORG-ROLLUP
           ELSE
           IF  BOOK-RUP2-TYPE =  'R'
              PERFORM 9070-CHECK-REG-ROLLUP.
           IF  HOLD-REPORT-ERROR-MSG NOT =  SPACES
               MOVE HOLD-REPORT-ERROR-MSG TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE.
           IF  RUP-MNEMONIC-INDEXES =  LOW-VALUES
               MOVE ERRMSG-INVALID-RUP TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9990-SET-ERROR
               PERFORM 10600-WRITE-BOOK-LINE.
           MOVE RUP-MNEMONIC-INDEXES TO BOOK-RUP2-LEVELS.
      /*****************************************************************
       10052-MOVE-RUP1-MNEMONICS.
      ******************************************************************
           MOVE IN-BOOK-RUP1-MNEM (WORK-INDEX)
               TO RUP-MNEMONIC (WORK-INDEX).
      ******************************************************************
       10053-MOVE-RUP2-MNEMONICS.
      ******************************************************************
           MOVE IN-BOOK-RUP2-MNEM (WORK-INDEX)
               TO RUP-MNEMONIC (WORK-INDEX).
      /*****************************************************************
       10055-CHECK-RDF-RUP1.
      ******************************************************************
           MOVE 'N' TO AT-LEAST-ONE-BOOK-RUP-ON-RPT.
           MOVE 'Y' TO EVERY-BOOK-RUP-ON-RPT.
           SET REPORT-INDEX TO WORK-RPT-INDEX (BOOK-REPORT-INDEX).
           MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.
           PERFORM 10057-CHECK-EACH-BOOK-RUP
               VARYING RUP-INDEX FROM 1 BY 1
               UNTIL RUP-INDEX  >  MAX-RUP-LEVELS
                  OR RUP-MNEMONIC (RUP-INDEX)  =  SPACES.
           IF  AT-LEAST-ONE-BOOK-RUP-ON-RPT =  'N'
               MOVE RDF-REPORT-ID TO BD-REPORT-ID
               MOVE ERRMSG-NO-RUP-MATCH TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE
               PERFORM 9990-SET-ERROR
               MOVE SPACES TO BD-REPORT-ID
      *BWM*
           END-IF.
      *BWM*ELSE
      *BWM*IF  EVERY-BOOK-RUP-ON-RPT =  'N'
      *BWM*    MOVE RDF-REPORT-ID TO BD-REPORT-ID
      *BWM*    MOVE ERRMSG-RUP-MATCH TO BOOK-ERROR-MSG
      *BWM*    MOVE ERRMSG-WARNING TO BOOK-WARNING-MSG
      *BWM*    MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
      *BWM*    PERFORM 10600-WRITE-BOOK-LINE
      *BWM*    MOVE SPACES TO BOOK-WARNING-MSG  BD-REPORT-ID.
      ******************************************************************
       10056-CHECK-RDF-RUP2.
      ******************************************************************
           MOVE 'Y' TO EVERY-BOOK-RUP-ON-RPT.
           SET REPORT-INDEX TO WORK-RPT-INDEX (BOOK-REPORT-INDEX).
           MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.

           MOVE RDF-RUP2-MNEMONICS TO RDF-RUP1-MNEMONICS.

           PERFORM 10057-CHECK-EACH-BOOK-RUP
               VARYING RUP-INDEX FROM 1 BY 1
               UNTIL RUP-INDEX  >  MAX-RUP-LEVELS
                  OR RUP-MNEMONIC (RUP-INDEX)  =  SPACES.
      *BWM*IF  EVERY-BOOK-RUP-ON-RPT =  'N'
      *BWM*    MOVE RDF-REPORT-ID TO BD-REPORT-ID
      *BWM*    MOVE ERRMSG-RUP-MATCH TO BOOK-ERROR-MSG
      *BWM*    MOVE ERRMSG-WARNING TO BOOK-WARNING-MSG
      *BWM*    MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
      *BWM*    PERFORM 10600-WRITE-BOOK-LINE
      *BWM*    MOVE SPACES TO BOOK-WARNING-MSG  BD-REPORT-ID.
      /********************************************************
       10057-CHECK-EACH-BOOK-RUP.
      *********************************************************
           MOVE 'N' TO BOOK-RUP-ON-RPT.
           PERFORM 10058-CHECK-EACH-REPORT-RUP
               VARYING RDF-WORK-INDEX FROM 1 BY 1
               UNTIL RDF-WORK-INDEX  >  MAX-RUP-LEVELS
                  OR RDF-RUP1-MNEMONIC (RDF-WORK-INDEX)  =  SPACES
                  OR BOOK-RUP-ON-RPT  =  'Y'.
           IF  BOOK-RUP-ON-RPT =  'N'
               MOVE 'N' TO EVERY-BOOK-RUP-ON-RPT
           ELSE
               MOVE 'Y' TO AT-LEAST-ONE-BOOK-RUP-ON-RPT.
      *********************************************************
       10058-CHECK-EACH-REPORT-RUP.
      *********************************************************
           IF  RUP-MNEMONIC (RUP-INDEX)
                    =  RDF-RUP1-MNEMONIC (RDF-WORK-INDEX)
               MOVE 'Y' TO BOOK-RUP-ON-RPT.
      /********************************************************
       10060-SET-UP-EXB-TABLES.
      *********************************************************
      *    COMMENTS :
      *********************************************************
      *    DISPLAY '10060-SET-UP-EXB-TABLES'.
           MOVE SPACES TO RUP-LIT-MOVED-FLAGS.
           MOVE 'N' TO MOVE-RUP1-LITERALS-FLAG.
           MOVE 'N' TO MOVE-RUP2-LITERALS-FLAG.
           IF  REC5-RUP1-LITERAL-FLAG =  'Y'
               PERFORM 10062-CHECK-RUP1-LITERALS.
           IF  REC5-RUP2-LITERAL-FLAG =  'Y'
               PERFORM 10063-CHECK-RUP2-LITERALS.
           IF  MOVE-RUP1-LITERALS-FLAG =  'Y'
           OR MOVE-RUP2-LITERALS-FLAG  =  'Y'
               PERFORM 10067-MOVE-SAVED-REC5-LITERALS
                   VARYING LIT-INDEX FROM 1 BY 1
                   UNTIL  LIT-INDEX  >  MAX-RUP-LEVELS.
           MOVE LOW-VALUES TO REC5-RUP-LEVEL-TABLES.
           MOVE SPACES TO REC5-RUP-CODE-TABLES.
           PERFORM 10070-SET-UP-REC5-LEVELS
               VARYING WORK-INDEX FROM 1 BY 1
               UNTIL WORK-INDEX  > MAX-RUP-LEVELS.

           PERFORM 10080-EXPAND-RUP1.

           MOVE LOW-VALUES TO REC5-RUP2-TABLE.
           MOVE 1 TO RUP2-INDEX.
           IF  IN-BOOK-RUP2-CODES NOT =  SPACES
               PERFORM 10120-EXPAND-RUP2.

           MOVE IN-BOOK-REC TO SAVE-BOOK-REC5.

           PERFORM 10300-PROCESS-RUP1-KEYS
               VARYING RUP1-INDEX FROM 1 BY 1
               UNTIL REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)  =  ZERO.

      *********************************************************
       10062-CHECK-RUP1-LITERALS.
      *********************************************************
      *    COMMENTS :
      *********************************************************
      *    DISPLAY '10062-CHECK-RUP1-LITERALS'.
           PERFORM VARYING LIT-INDEX FROM 1 BY 1
               UNTIL (SAVED-REC5-RUP1-CODE (LIT-INDEX) NOT = 'XX'
                  AND SAVED-REC5-RUP1-CODE (LIT-INDEX) NOT = SPACES)
                  OR  LIT-INDEX  >  MAX-RUP-LEVELS
           END-PERFORM.

           PERFORM VARYING WORK-INDEX FROM 1 BY 1
               UNTIL  IN-BOOK-RUP1-CODE (WORK-INDEX) NOT = SPACES
                  OR  WORK-INDE      MAX-RUP-LEVELS
           END-PERFORM.

           IF  REC5-RUP1-LEVEL (LIT-INDEX)
                             NOT >   REC5-RUP1-LEVEL (WORK-INDEX)
               MOVE 'Y' TO MOVE-RUP1-LITERALS-FLAG
           END-IF.

      *********************************************************
       10063-CHECK-RUP2-LITERALS.
      *********************************************************
      *    COMMENTS :
      *********************************************************
      *    DISPLAY '10063-CHECK-RUP2-LITERALS'.
           PERFORM VARYING LIT-INDEX FROM 1 BY 1
               UNTIL (SAVED-REC5-RUP2-CODE (LIT-INDEX) NOT = 'XX'
                  AND SAVED-REC5-RUP2-CODE (LIT-INDEX) NOT = SPACES)
                  OR  LIT-INDEX  >  MAX-RUP-LEVELS
           END-PERFORM.

           PERFORM VARYING WORK-INDEX FROM 1 BY 1
               UNTIL  IN-BOOK-RUP2-CODE (WORK-INDEX) NOT = SPACES
                  OR  WORK-INDEX  >  MAX-RUP-LEVELS
           END-PERFORM.

           IF  REC5-RUP2-LEVEL (LIT-INDEX)
                             NOT >   REC5-RUP2-LEVEL (WORK-INDEX)
               MOVE 'Y' TO MOVE-RUP2-LITERALS-FLAG
           END-IF.

      *********************************************************
       10067-MOVE-SAVED-REC5-LITERALS.
      *********************************************************
      *    COMMENTS :
      *********************************************************
      *    DISPLAY '10067-MOVE-SAVED-REC5-LITERALS'.
           IF  SAVED-REC5-RUP1-CODE (LIT-INDEX) NOT =  'XX'
           AND SAVED-REC5-RUP1-CODE (LIT-INDEX)  NOT =  SPACES
               IF  IN-BOOK-RUP1-CODE (LIT-INDEX) =  SPACES
                   MOVE 'Y' TO RUP1-LIT-MOVED-FLAG (LIT-INDEX)
                   MOVE SAVED-REC5-RUP1-CODE (LIT-INDEX)
                       TO IN-BOOK-RUP1-CODE (LIT-INDEX)
                   MOVE SAVED-REC5-RUP1-SUPP (LIT-INDEX)
                       TO IN-BOOK-RUP1-SUPP (LIT-INDEX).
           IF  SAVED-REC5-RUP2-CODE (LIT-INDEX) NOT =  'XX'
           AND SAVED-REC5-RUP2-CODE (LIT-INDEX)  NOT =  SPACES
               IF  IN-BOOK-RUP2-CODE (LIT-INDEX) =  SPACES
                   MOVE 'Y' TO RUP2-LIT-MOVED-FLAG (LIT-INDEX)
                   MOVE SAVED-REC5-RUP2-CODE (LIT-INDEX)
                       TO IN-BOOK-RUP2-CODE (LIT-INDEX)
                   MOVE SAVED-REC5-RUP2-SUPP (LIT-INDEX)
                       TO IN-BOOK-RUP2-SUPP (LIT-INDEX).
      /*****************************************************************
       10070-SET-UP-REC5-LEVELS.
      ******************************************************************
      *   COMMENTS :
      ******************************************************************
      *    DISPLAY '10070-SET-UP-REC5-LEVELS'.
           IF  IN-BOOK-RUP1-CODE (WORK-INDEX) NOT =  SPACES
               IF  BOOK-RUP1-LEVEL (WORK-INDEX) NOT =  ZERO
                   MOVE BOOK-RUP1-LEVEL (WORK-INDEX)
                       TO REC5-RUP1-LEVEL (WORK-INDEX)
                   MOVE IN-BOOK-RUP1-CODE (WORK-INDEX)
                       TO REC5-RUP1-CODE (WORK-INDEX)
                   MOVE IN-BOOK-RUP1-SUPP (WORK-INDEX)
                       TO REC5-RUP1-SUPP (WORK-INDEX).
           IF  IN-BOOK-RUP1-CODE (WORK-INDEX) NOT =  SPACES
               IF  IN-BOOK-RUP1-CODE (WORK-INDEX) NOT =  'XX'
                   MOVE 'Y' TO REC5-RUP1-LITERAL-FLAG.
           IF  IN-BOOK-RUP2-CODE (WORK-INDEX) NOT =  SPACES
               IF  BOOK-RUP2-LEVEL (WORK-INDEX) NOT =  ZERO
                   MOVE BOOK-RUP2-LEVEL (WORK-INDEX)
                       TO REC5-RUP2-LEVEL (WORK-INDEX)
                   MOVE IN-BOOK-RUP2-CODE (WORK-INDEX)
                       TO REC5-RUP2-CODE (WORK-INDEX)
                   MOVE IN-BOOK-RUP2-SUPP (WORK-INDEX)
                       TO REC5-RUP2-SUPP (WORK-INDEX).
           IF  IN-BOOK-RUP2-CODE (WORK-INDEX) NOT =  SPACES
               IF  IN-BOOK-RUP2-CODE (WORK-INDEX) NOT =  'XX'
                   MOVE 'Y' TO REC5-RUP2-LITERAL-FLAG.
      /*****************************************************************
       10080-EXPAND-RUP1.
      ******************************************************************
      *    DISPLAY '10080-EXPAND-RUP1'.
           MOVE LOW-VALUES TO REC5-RUP1-TABLE.
           MOVE 1 TO RUP1-INDEX.
           IF  BOOK-RUP1-TYPE =  'O'
               MOVE BOOK-ORG-ID-INDEX TO ORG-ID-INDEX
               PERFORM 10090-SELECT-RUP1-ORGS
                   VARYING ORG-ENTRY-INDEX  FROM 2 BY 1
                   UNTIL  ORG-ENTRY-INDEX  >  MAX-ORG
                      OR  ORG-TABLE-ENTRY-1
                            (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                                   =  LOW-VALUES
           ELSE
           IF  BOOK-RUP1-TYPE =  'R'
               SET REG-ID-INDEX TO BOOK-REG-ID-INDEX
               PERFORM 10100-SELECT-RUP1-REGS
                   VARYING  REG-ENTRY-INDEX  FROM 2 BY 1
                   UNTIL   REG-ENTRY-INDEX  >  MAX-REG
                      OR  REG-TABLE-ENTRY
                            (REG-ID-INDEX,  REG-ENTRY-INDEX)
                                   =  LOW-VALUES
           ELSE
               PERFORM 10110-MOVE-RUP1-PRIMES
                   VARYING WORK-INDEX  FROM 1 BY 1
                   UNTIL  WORK-INDEX  >  MAX-PRIME-RUP-LEVELS
                      OR  BOOK-RUP1-LEVEL (WORK-INDEX)
                                   =  ZERO.
           IF  RUP1-INDEX =  1
           DISPLAY ' BOOK DETAIL LINE:' BOOK-DETAIL-LINE
               MOVE ERRMSG-NO-SELECTION TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 9990-SET-ERROR
               PERFORM 10600-WRITE-BOOK-LINE.
      /*****************************************************************
       10090-SELECT-RUP1-ORGS.
      ******************************************************************
           MOVE ORG-ID-INDEX TO ORG-FLAG-ID-INDEX.
           MOVE ORG-ENTRY-INDEX TO ORG-FLAG-INDEX.
           IF  PRINT-SUPP-FLAG =  SPACE
               PERFORM 10092-CHECK-ORG-LEVEL
           ELSE
              IF  ORG-TBL-PRINT-SUPP-FLAG
                (ORG-FLAG-ID-INDEX, ORG-FLAG-INDEX)  =  SPACE
                   PERFORM 10092-CHECK-ORG-LEVEL.
      /*****************************************************************
       10092-CHECK-ORG-LEVEL.
      ******************************************************************
      *    DISPLAY '10090-SELECT-RUP1-ORGS'.
           MOVE ORG-TBL-KEY-LEVEL (ORG-ID-INDEX, ORG-ENTRY-INDEX)
               TO   WORK-LEVEL.
      *    DISPLAY ' ORG WORK LEVEL = ' WORK-LEVEL.
           MOVE 1 TO MATCH-INDEX.

           PERFORM VARYING MATCH-INDEX FROM 1 BY 1
               UNTIL  MATCH-INDEX  >  MAX-RUP-LEVELS
                  OR  WORK-LEVEL  =  REC5-RUP1-LEVEL (MATCH-INDEX)
           END-PERFORM.

           IF  MATCH-INDEX  NOT >  MAX-RUP-LEVELS
               IF  REC5-RUP1-LITERAL-FLAG  NOT =  'Y'
                   MOVE ORG-ENTRY-INDEX
                       TO REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                   MOVE WORK-LEVEL TO
                        REC5-RUP1-ENTRY-LEVEL (RUP1-INDEX)
                   MOVE 'Y' TO ORG-TBL-USAGE-FLAG
                        (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                   ADD 1 TO RUP1-INDEX
               ELSE
                   MOVE 'Y' TO LITERAL-MATCH-FLAG
                   MOVE ORG-TBL-ROLLUP-KEY
                     (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                       TO   ORG-KEY-WORK-AREA
                   PERFORM 10097-RUP1-ORG-LIT-MATCH
                       VARYING LIT-INDEX FROM 1 BY 1
                       UNTIL  LIT-INDEX  >  MAX-RUP-LEVELS
                   IF  LITERAL-MATCH-FLAG  =  'Y'
                       MOVE ORG-ENTRY-INDEX
                           TO REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                       MOVE WORK-LEVEL TO
                            REC5-RUP1-ENTRY-LEVEL (RUP1-INDEX)
                       MOVE 'Y' TO ORG-TBL-USAGE-FLAG
                            (ORG-ID-INDEX, ORG-ENTRY-INDEX)
      *                DISPLAY '         MATCH ON LITERAL'
                       ADD 1 TO RUP1-INDEX
                   END-IF
               END-IF
           END-IF.

      /***********************************************************
       10097-RUP1-ORG-LIT-MATCH.
      ************************************************************
      *    DISPLAY '10097-RUP1-ORG-LIT-MATCH'.
      ************************************************************
      * COMMENTS :  THIS IS A TRICKY LITTLE BIT OF LOGIC !
      *    THE POINT IS THAT WE DO NOT WANT TO SELECT AN ENTRY
      *    THAT WE HAVE ALREADY SELECTED FROM A PREVIOUS RECORD
      *    TYPE '5', IF THAT RECORD '5' HAD A LITERAL CODED ON IT.
      *    SO WHAT WE HAVE TO DO IS CHECK WHETHER THE LEVEL OF THE
      *    ORG KEY (IN 'WORK-LEVEL') IS EQUAL TO THE LEVEL THAT
      *    THE LITERAL WAS CODED AT ON A PREVIOUS '5' RECORD.
      *    IF IT IS, WE SET THE LIT-MATCH-FLAG TO 'N', WHICH CAUSES
      *    THE ENTRY TO NOT BE SELECTED.      WHEW !     CPL
      ************************************************************
           IF  REC5-RUP1-CODE (LIT-INDEX) NOT =  'XX'
                                     AND  NOT =  SPACES
               MOVE REC5-RUP1-LEVEL (LIT-INDEX) TO ORG-LEVEL-INDEX
               IF  ORG-KEY-WORK (ORG-LEVEL-INDEX) NOT =
                          REC5-RUP1-CODE (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, BUT SHOULD THIS LEVEL BE SUPPRESSED ?
               IF  REC5-RUP1-SUPP (LIT-INDEX) NOT =  SPACE
               AND WORK-LEVEL  =  REC5-RUP1-LEVEL (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, SO CHECK IF IT IS FROM A PREV '5' REC
               IF  RUP1-LIT-MOVED-FLAG (LIT-INDEX) =  'Y'
                   IF  WORK-LEVEL =  REC5-RUP1-LEVEL (LIT-INDEX)
                       MOVE 'N' TO LITERAL-MATCH-FLAG.
      /*****************************************************************
       10100-SELECT-RUP1-REGS.
      ******************************************************************
           MOVE REG-TBL-KEY-LEVEL (REG-ID-INDEX,  REG-ENTRY-INDEX)
               TO   WORK-LEVEL.

           PERFORM VARYING MATCH-INDEX FROM 1 BY 1
               UNTIL  MATCH-INDEX  >  MAX-RUP-LEVELS
                  OR  WORK-LEVEL  =  REC5-RUP1-LEVEL (MATCH-INDEX)
           END-PERFORM.

           IF  MATCH-INDEX  NOT >  MAX-RUP-LEVELS
               IF  REC5-RUP1-LITERAL-FLAG  NOT =  'Y'
                   SET REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                              TO  REG-ENTRY-INDEX
                   MOVE WORK-LEVEL TO
                        REC5-RUP1-ENTRY-LEVEL (RUP1-INDEX)
                   MOVE 'Y' TO REG-TBL-USAGE-FLAG
                        (REG-ID-INDEX, REG-ENTRY-INDEX)
                   ADD 1 TO RUP1-INDEX
               ELSE
                   MOVE 'Y' TO LITERAL-MATCH-FLAG
                   MOVE REG-TBL-ROLLUP-KEY
                         (REG-ID-INDEX,  REG-ENTRY-INDEX)
                             TO   REG-KEY-WORK-AREA
                   PERFORM 10107-RUP1-REG-LIT-MATCH
                       VARYING LIT-INDEX FROM 1 BY 1
                       UNTIL  LIT-INDEX  >  MAX-RUP-LEVELS
                   IF  LITERAL-MATCH-FLAG  =  'Y'
                       SET REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                                  TO  REG-ENTRY-INDEX
                       MOVE WORK-LEVEL TO
                            REC5-RUP1-ENTRY-LEVEL (RUP1-INDEX)
                       MOVE 'Y' TO REG-TBL-USAGE-FLAG
                            (REG-ID-INDEX, REG-ENTRY-INDEX)
                       ADD 1 TO RUP1-INDEX
                   END-IF
               END-IF
           END-IF.

      /***********************************************************
       10107-RUP1-REG-LIT-MATCH.
      ************************************************************
           IF  REC5-RUP1-CODE (LIT-INDEX) NOT =  'XX'
                                     AND  NOT =  SPACES
               MOVE REC5-RUP1-LEVEL (LIT-INDEX) TO REG-LEVEL-INDEX
               IF  REG-KEY-WORK (REG-LEVEL-INDEX) NOT =
                          REC5-RUP1-CODE (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, BUT SHOULD THIS LEVEL BE SUPPRESSED ?
               IF  REC5-RUP1-SUPP (LIT-INDEX) NOT =  SPACE
               AND WORK-LEVEL  =  REC5-RUP1-LEVEL (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, SO CHECK IF IT IS FROM A PREV '5' REC
               IF  RUP1-LIT-MOVED-FLAG (LIT-INDEX) =  'Y'
                   IF  WORK-LEVEL =  REC5-RUP1-LEVEL (LIT-INDEX)
                       MOVE 'N' TO LITERAL-MATCH-FLAG.
      ******************************************************************
       10110-MOVE-RUP1-PRIMES.
      ******************************************************************
           MOVE BOOK-RUP1-LEVEL (WORK-INDEX) TO
               REC5-RUP1-ENTRY-INDEX (RUP1-INDEX).
           MOVE BOOK-RUP1-LEVEL (WORK-INDEX) TO
               REC5-RUP1-ENTRY-LEVEL (RUP1-INDEX).
           ADD 1 TO RUP1-INDEX.
      /*****************************************************************
       10120-EXPAND-RUP2.
      ******************************************************************
           IF  BOOK-RUP2-TYPE =  'O'
               MOVE BOOK-ORG-ID-INDEX TO ORG-ID-INDEX
               PERFORM 10130-SELECT-RUP2-ORGS
                   VARYING ORG-ENTRY-INDEX  FROM 2 BY 1
                   UNTIL  ORG-ENTRY-INDEX  >  MAX-ORG
                      OR  ORG-TABLE-ENTRY-1
                             (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                                   =  LOW-VALUES
           ELSE
           IF  BOOK-RUP2-TYPE =  'R'
               SET REG-ID-INDEX TO BOOK-REG-ID-INDEX
               PERFORM 10140-SELECT-RUP2-REGS
                   VARYING  REG-ENTRY-INDEX  FROM 2 BY 1
                   UNTIL   REG-ENTRY-INDEX  >  MAX-REG
                      OR  REG-TABLE-ENTRY
                            (REG-ID-INDEX,  REG-ENTRY-INDEX)
                                   =  LOW-VALUES
           ELSE
               PERFORM 10150-MOVE-RUP2-PRIMES
                   VARYING WORK-INDEX  FROM 1 BY 1
                   UNTIL  WORK-INDEX  >  MAX-PRIME-RUP-LEVELS
                      OR  BOOK-RUP2-LEVEL (WORK-INDEX)
                                   =  ZERO.
      /*****************************************************************
       10130-SELECT-RUP2-ORGS.
      ******************************************************************
           MOVE ORG-TBL-KEY-LEVEL (ORG-ID-INDEX, ORG-ENTRY-INDEX)
               TO   WORK-LEVEL.

           PERFORM VARYING MATCH-INDEX FROM 1 BY 1
               UNTIL  MATCH-INDEX  >  MAX-RUP-LEVELS
                  OR  WORK-LEVEL  =  REC5-RUP2-LEVEL (MATCH-INDEX)
           END-PERFORM.

           IF  MATCH-INDEX  NOT >  MAX-RUP-LEVELS
               IF  REC5-RUP2-LITERAL-FLAG  NOT =  'Y'
                   MOVE ORG-ENTRY-INDEX
                       TO REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                   MOVE WORK-LEVEL TO
                        REC5-RUP2-ENTRY-LEVEL (RUP2-INDEX)
                   MOVE 'Y' TO ORG-TBL-USAGE-FLAG
                        (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                   ADD 1 TO RUP2-INDEX
               ELSE
                   MOVE 'Y' TO LITERAL-MATCH-FLAG
                   MOVE ORG-TBL-ROLLUP-KEY
                     (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                       TO   ORG-KEY-WORK-AREA
                   PERFORM 10137-RUP2-ORG-LIT-MATCH
                       VARYING LIT-INDEX FROM 1 BY 1
                       UNTIL  LIT-INDEX  >  MAX-RUP-LEVELS
                   IF  LITERAL-MATCH-FLAG  =  'Y'
                       MOVE ORG-ENTRY-INDEX
                           TO  REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                       MOVE WORK-LEVEL TO
                            REC5-RUP2-ENTRY-LEVEL (RUP2-INDEX)
                       MOVE 'Y' TO ORG-TBL-USAGE-FLAG
                            (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                       ADD 1 TO RUP2-INDEX
                   END-IF
               END-IF
           END-IF.

      /***********************************************************
       10137-RUP2-ORG-LIT-MATCH.
      ************************************************************
           IF  REC5-RUP2-CODE (LIT-INDEX) NOT =  'XX'
                                     AND  NOT =  SPACES
               MOVE REC5-RUP2-LEVEL (LIT-INDEX) TO ORG-LEVEL-INDEX
               IF  ORG-KEY-WORK (ORG-LEVEL-INDEX) NOT =
                          REC5-RUP2-CODE (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, BUT SHOULD THIS LEVEL BE SUPPRESSED ?
               IF  REC5-RUP2-SUPP (LIT-INDEX) NOT =  SPACE
               AND WORK-LEVEL  =  REC5-RUP2-LEVEL (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, SO CHECK IF IT IS FROM A PREV '5' REC
               IF  RUP2-LIT-MOVED-FLAG (LIT-INDEX) =  'Y'
                   IF  WORK-LEVEL =  REC5-RUP2-LEVEL (LIT-INDEX)
                       MOVE 'N' TO LITERAL-MATCH-FLAG.
      /*****************************************************************
       10140-SELECT-RUP2-REGS.
      ******************************************************************
           MOVE REG-TBL-KEY-LEVEL (REG-ID-INDEX,  REG-ENTRY-INDEX)
               TO   WORK-LEVEL.

           PERFORM VARYING MATCH-INDEX FROM 1 BY 1
               UNTIL  MATCH-INDEX  >  MAX-RUP-LEVELS
                  OR  WORK-LEVEL  =  REC5-RUP2-LEVEL (MATCH-INDEX)
           END-PERFORM.

           IF  MATCH-INDEX  NOT >  MAX-RUP-LEVELS
               IF  REC5-RUP2-LITERAL-FLAG  NOT =  'Y'
                   SET REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                              TO  REG-ENTRY-INDEX
                   MOVE WORK-LEVEL TO
                       REC5-RUP2-ENTRY-LEVEL (RUP2-INDEX)
                   MOVE 'Y' TO REG-TBL-USAGE-FLAG
                        (REG-ID-INDEX, REG-ENTRY-INDEX)
                   ADD 1 TO RUP2-INDEX
               ELSE
                   MOVE 'Y' TO LITERAL-MATCH-FLAG
                   MOVE REG-TBL-ROLLUP-KEY
                      (REG-ID-INDEX,  REG-ENTRY-INDEX)
                              TO   REG-KEY-WORK-AREA
                   PERFORM 10147-RUP2-REG-LIT-MATCH
                       VARYING LIT-INDEX FROM 1 BY 1
                       UNTIL  LIT-INDEX  >  MAX-RUP-LEVELS
                   IF  LITERAL-MATCH-FLAG  =  'Y'
                       SET REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                                  TO  REG-ENTRY-INDEX
                       MOVE WORK-LEVEL TO
                           REC5-RUP2-ENTRY-LEVEL (RUP2-INDEX)
                       MOVE 'Y' TO REG-TBL-USAGE-FLAG
                            (REG-ID-INDEX, REG-ENTRY-INDEX)
                       ADD 1 TO RUP2-INDEX
                   END-IF
               END-IF
           END-IF.

      /***********************************************************
       10147-RUP2-REG-LIT-MATCH.
      ************************************************************
           IF  REC5-RUP2-CODE (LIT-INDEX) NOT =  'XX'
                                     AND  NOT =  SPACES
               MOVE REC5-RUP2-LEVEL (LIT-INDEX) TO REG-LEVEL-INDEX
               IF  REG-KEY-WORK (REG-LEVEL-INDEX) NOT =
                          REC5-RUP2-CODE (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, BUT SHOULD THIS LEVEL BE SUPPRESSED ?
               IF  REC5-RUP2-SUPP (LIT-INDEX) NOT =  SPACE
               AND WORK-LEVEL  =  REC5-RUP2-LEVEL (LIT-INDEX)
                   MOVE 'N' TO LITERAL-MATCH-FLAG
               ELSE
      *** THE LITERAL MATCHES, SO CHECK IF IT IS FROM A PREV '5' REC
               IF  RUP2-LIT-MOVED-FLAG (LIT-INDEX) =  'Y'
                   IF  WORK-LEVEL =  REC5-RUP2-LEVEL (LIT-INDEX)
                       MOVE 'N' TO LITERAL-MATCH-FLAG.
      ******************************************************************
       10150-MOVE-RUP2-PRIMES.
      ******************************************************************
           MOVE BOOK-RUP2-LEVEL (WORK-INDEX) TO
               REC5-RUP2-ENTRY-INDEX (RUP2-INDEX).
           MOVE BOOK-RUP2-LEVEL (WORK-INDEX) TO
               REC5-RUP2-ENTRY-LEVEL (RUP2-INDEX).
           ADD 1 TO RUP2-INDEX.
      /*****************************************************************
       10300-PROCESS-RUP1-KEYS.
      ******************************************************************
      *    DISPLAY '10300-PROCESS-RUP1-KEYS'.

           MOVE LOW-VALUES TO CALC-WORK-RECORD.
           MOVE '1' TO CALC-REC-LCP-FLAG.

           IF  BOOK-RUP1-TYPE =  'O'
               MOVE 'O' TO CALC-REC-TYPE
               COMPUTE  CALC-REC-REL-REC  =
                 ((BOOK-ORG-ID-INDEX - 1)  *  MAX-ORG)
                 +  (REC5-RUP1-ENTRY-INDEX (RUP1-INDEX))
           ELSE
           IF  BOOK-RUP1-TYPE =  'R'
               MOVE 'R' TO CALC-REC-TYPE
               COMPUTE  CALC-REC-REL-REC  =
                 ((BOOK-REG-ID-INDEX - 1)  *  MAX-REG)
                 +  (REC5-RUP1-ENTRY-INDEX (RUP1-INDEX))
           ELSE
               MOVE 'P' TO CALC-REC-TYPE
               MOVE REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                     TO   CALC-REC-REL-REC.

           MOVE REC5-RUP1-ENTRY-LEVEL (RUP1-INDEX)
                  TO RUP1-WORK-LEVEL.

           MOVE LOW-VALUES TO CALC-WORK-RECORD-2.
           MOVE SPACES TO RUP2-ENTRY-FLAGS.

           IF  BOOK-RUP2-LEVELS NOT =  LOW-VALUES
               PERFORM 10320-PROCESS-RUP2-KEYS
                 VARYING  RUP2-INDEX FROM 1 BY 1
                 UNTIL  REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                                  =   ZERO
           ELSE
               PERFORM 10350-WRITE-BOOK-CALC-RECS
                 VARYING  BOOK-REPORT-INDEX  FROM 1 BY 1
                 UNTIL  BOOK-REPORT-INDEX  >  MAX-RPTS-ON-BOOK
                    OR  WORK-RPT-INDEX (BOOK-REPORT-INDEX)  =  ZERO.
      /*****************************************************************
       10320-PROCESS-RUP2-KEYS.
      ******************************************************************

           MOVE LOW-VALUES TO CALC-WORK-RECORD-2.
           MOVE '2' TO CALC-REC2-LCP-FLAG.

           IF  BOOK-RUP2-TYPE =  'O'
               MOVE 'O' TO CALC-REC2-TYPE
               COMPUTE  CALC-REC2-REL-REC  =
                 ((BOOK-ORG-ID-INDEX - 1)  *  MAX-ORG)
                 +  (REC5-RUP2-ENTRY-INDEX (RUP2-INDEX))
           ELSE
           IF  BOOK-RUP2-TYPE =  'R'
               MOVE 'R' TO CALC-REC2-TYPE
               COMPUTE  CALC-REC2-REL-REC  =
                 ((BOOK-REG-ID-INDEX - 1)  *  MAX-REG)
                 +  (REC5-RUP2-ENTRY-INDEX (RUP2-INDEX))
           ELSE
           IF  BOOK-RUP2-TYPE =  'P'
               MOVE 'P' TO CALC-REC2-TYPE
               MOVE REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                    TO   CALC-REC2-REL-REC.

           MOVE REC5-RUP2-ENTRY-LEVEL (RUP2-INDEX)
                    TO   RUP2-WORK-LEVEL.

           PERFORM 10350-WRITE-BOOK-CALC-RECS
               VARYING  BOOK-REPORT-INDEX  FROM 1 BY 1
               UNTIL  BOOK-REPORT-INDEX  >  MAX-RPTS-ON-BOOK
                  OR  WORK-RPT-INDEX (BOOK-REPORT-INDEX)  =  ZERO.
      /**************************************************************
       10350-WRITE-BOOK-CALC-RECS.
      ***************************************************************
      *    COMMENTS : TRICKY, TRICKY, TRICKY!!! (1) WE WANT TO INTER-
      *     LEAVE REPORTS THAT HAVE A RUP2 WITH THOSE THAT DO NOT,
      *     AND (2) WE DO NOT WANT TO PRODUCE A REPORT AT ANY
      *     LEVEL THAT HAS NOT BEEN SPECIFIED ON ITS DEFINITION.
      *     SO..... FOR (1), WE LOOP THROUGH EACH REPORT'S RUP1/RUP2
      *     INDEXES TO SEE IF ANY MATCH THE LEVEL OF THE SELECTED
      *     KEY (PARAGRAPH 10355- , ALONG WITH THE 'WORK-SWITCHES')
      *     FOR (2), A SET OF SWITCHES IS SET UP FOR EACH REPORT
      *     ON THIS SECTION OF THE BOOK (RUP2-ENTRY-FLAGS), SO THAT
      *     EVEN THOUGH A GIVEN REPORT IS NOT DEFINED AT RUP2 IT
      *     MUST BE PUT OUT ONCE (AND ONLY ONCE) FOR THE RUP1 KEY.
      *     SINCE THE LOGIC RUNS THROUGH ALL THE REPORTS FOR EACH
      *     RUP2 KEY (IF PERFORMED FROM 10320-PROCESS-RUP2-KEYS)
      *     WE ONLY WANT TO PUT OUT THE REPORT OUT ONCE - WE SET THE
      *     FLAG WHEN WE DO, SO WE WILL NOT PUT THE REPORT AGAIN ON
      *     THE NEXT RUP2 KEY !!!  NOTICE THAT THESE FLAGS ARE
      *     CLEARED IN EACH REPETITION OF 10300-PROCESS-RUP1-KEYS,
      *     SO THAT ALL REPORTS WILL COME OUT AT LEAST ONCE FOR EACH
      *     RUP1 KEY.        WHEW !         - CPL

      *    DISPLAY '10350-WRITE-BOOK-CALC-RECS'.
           SET REPORT-INDEX TO WORK-RPT-INDEX (BOOK-REPORT-INDEX).
           MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.
           MOVE 'N' TO RUP1-WORK-SWITCH.
           IF  RDF-RUP2-INDEXES =  LOW-VALUES
               MOVE 'Y' TO RUP2-WORK-SWITCH
           ELSE
               MOVE 'N' TO RUP2-WORK-SWITCH.
           PERFORM 10355-CHECK-RDF-RUP1-RUP2
               VARYING RDF-WORK-INDEX FROM 1 BY 1
               UNTIL   RDF-WORK-INDEX  >  MAX-RUP-LEVELS
                  OR  (RDF-RUP1-INDEX (RDF-WORK-INDEX)  =  ZERO
                  AND  RDF-RUP2-INDEX (RDF-WORK-INDEX)  =  ZERO).
           MOVE WORK-RPT-INDEX (BOOK-REPORT-INDEX) TO
               CALC-REC-REPORT-INDEX
               CALC-REC2-REPORT-INDEX
               EXB-REPORT-ID-INDEX.
           MOVE ZERO TO EXB-RUP1-INDEX  EXB-RUP2-INDEX.
           IF  RUP1-WORK-SWITCH =  'Y'
               IF  RDF-RUP2-INDEXES =  LOW-VALUES
                   IF  RUP2-ENTRY-FLAG (BOOK-REPORT-INDEX) =  SPACE
                       MOVE REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                             TO EXB-RUP1-INDEX
                       WRITE FD-CALC-WORK-REC FROM CALC-WORK-RECORD
                       MOVE 'Y' TO RUP2-ENTRY-FLAG (BOOK-REPORT-INDEX)
                   ELSE
                      NEXT SENTENCE
               ELSE
                   MOVE REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)
                         TO EXB-RUP1-INDEX
                   WRITE FD-CALC-WORK-REC FROM CALC-WORK-RECORD.
           IF  RDF-RUP2-INDEXES NOT =  LOW-VALUES
           AND  RUP2-WORK-SWITCH  =  'Y'
               MOVE REC5-RUP2-ENTRY-INDEX (RUP2-INDEX)
                       TO EXB-RUP2-INDEX
               WRITE FD-CALC-WORK-REC  FROM  CALC-WORK-RECORD-2.
           IF  EXB-RUP1-INDEX NOT =  ZERO
           OR EXB-RUP2-INDEX  NOT =  ZERO
               PERFORM 10357-WRITE-EXB.
      /
      ***************************************************************
       10355-CHECK-RDF-RUP1-RUP2.
      ***************************************************************
           IF  RUP1-WORK-LEVEL =  RDF-RUP1-INDEX (RDF-WORK-INDEX)
               MOVE 'Y' TO RUP1-WORK-SWITCH.
           IF  RUP2-WORK-LEVEL =  RDF-RUP2-INDEX (RDF-WORK-INDEX)
               MOVE 'Y' TO RUP2-WORK-SWITCH.
      ***************************************************************
       10357-WRITE-EXB.
      ***************************************************************
           ADD 1 TO EXB-BOOK-SEQUENCE-NO.
           WRITE FD-EXP-BOOK-DEF-FILE-REC  FROM  EXB-RECORD.
           IF  GEN-TOC-FLAG =  SPACES
               PERFORM 10360-GENERATE-TOC-LINE.
      /**************************************************************
       10360-GENERATE-TOC-LINE.
      ***************************************************************
           SET REPORT-INDEX TO WORK-RPT-INDEX (BOOK-REPORT-INDEX).
           MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.
           MOVE RDF-TOC-DESCRIPTION TO TOC-WORK-AREA-1.
           IF  BOOK-RUP1-TYPE =  'O'
               MOVE ORG-TBL-DESC (BOOK-ORG-ID-INDEX, EXB-RUP1-INDEX)
                    TO  TOC-WORK-AREA-2
               MOVE ORG-TBL-ROLLUP-KEY
                 (BOOK-ORG-ID-INDEX, EXB-RUP1-INDEX)
                          TO  TOC-ROLLUP-KEY
           ELSE
           IF  BOOK-RUP1-TYPE =  'R'
               MOVE REG-TBL-DESC (BOOK-REG-ID-INDEX, EXB-RUP1-INDEX)
                    TO  TOC-WORK-AREA-2
               MOVE REG-TBL-ROLLUP-KEY
                 (BOOK-REG-ID-INDEX, EXB-RUP1-INDEX)
                          TO  TOC-ROLLUP-KEY
           ELSE
           IF  BOOK-RUP1-TYPE =  'P'
               MOVE PRIME-TBL-DESC (EXB-RUP1-INDEX)
                    TO  TOC-WORK-AREA-2
               MOVE PRIME-TBL-ID (EXB-RUP1-INDEX)
                    TO TOC-ROLLUP-KEY.
           IF  RDF-RUP2-TYPE NOT =  SPACE
               PERFORM 10362-FORMAT-RUP2-TOC.
           MOVE EXB-BOOK-SEQUENCE-NO TO TCM-SEQUENCE-NO.
           MOVE TOC-WORK-AREA TO TCM-TEXT.
           MOVE EXB-BOOK-ID-INDEX TO TCM-BOOK-ID-INDEX.
           MOVE '2' TO TCM-RECORD-TYPE.
           MOVE ZERO TO TCM-MANUAL-PAGE-COUNT.
           WRITE FD-TBL-OF-CONT-FILE-REC  FROM  TCM-RECORD.
           ADD 1 TO TCM-COUNT.
           MOVE TCM-TEXT TO BD-TOC-TEXT.
           IF  BOOK-TITLE-FLAG NOT =  'T'
               MOVE 'T' TO BOOK-TITLE-FLAG
               PERFORM 10950-PRINT-BOOK-HEADINGS.
           MOVE BOOK-TOC-LINE TO FD-PRINTER2-REC.
           PERFORM 10900-WRITE-BOOK-LINE.
      /**************************************************************
       10362-FORMAT-RUP2-TOC.
      ***************************************************************
           MOVE TOC-WORK-AREA-2 TO TOC-RUP1-AREA.
           IF  RDF-RUP2-TYPE =  'O'
               MOVE ORG-TBL-DESC (BOOK-ORG-ID-INDEX, EXB-RUP2-INDEX)
                    TO  TOC-RUP2-AREA
           ELSE
           IF  RDF-RUP2-TYPE =  'R'
               MOVE REG-TBL-DESC (BOOK-REG-ID-INDEX, EXB-RUP2-INDEX)
                    TO  TOC-RUP2-AREA
           ELSE
           IF  RDF-RUP2-TYPE =  'P'
               MOVE PRIME-TBL-DESC (EXB-RUP2-INDEX)
                    TO  TOC-RUP2-AREA.
           MOVE TOC-RUP1-RUP2-AREA TO TOC-ROLLUP-AREA.
      /**************************************************************
       10400-PROCESS-REC6.
      ***************************************************************
      *  NOTES :
      ***************************************************************
           MOVE LOW-VALUES TO REC6-TABLE.
           MOVE 1 TO REC6-COUNT.

           PERFORM 10410-BUILD-REC6-RUP1-TABLES
               VARYING REC6-TBL-INDEX FROM 1 BY 1
               UNTIL END-OF-BOOK-FILE
                  OR IN-BOOK-REC-TYPE  NOT =  '6'.
           MOVE 'N' TO READ-BOOK-FLAG.

           IF  IN-BOOK-REC-TYPE = '1'
               AND IN-BOOK-ID NOT = SAVE-BOOK-ID
               MOVE 'N' TO BOOK-ONES-FLAG
               MOVE 'N' TO BOOK-REC-TYPE-FLAG.

      *    DISPLAY '*** EXPANDED BOOK SEQUENCE : ***'.
           MOVE LOW-VALUES TO REC6-WORK-TABLE.
           MOVE 1 TO REC6-WORK-INDEX.
           PERFORM 10470-INTERLEAVE-REC6-RUP1
               VARYING REC6-ENTRY-INDEX FROM 1 BY 1
               UNTIL REC6-ENTRY-INDEX  > MAX-ORG
                  OR REC6-RUP1-ENTRY-INDEX (1, REC6-ENTRY-INDEX)
                                 =  ZERO.
           MOVE REC6-WORK-TABLE TO REC5-RUP1-TABLE.

           PERFORM 10300-PROCESS-RUP1-KEYS
               VARYING RUP1-INDEX FROM 1 BY 1
               UNTIL REC5-RUP1-ENTRY-INDEX (RUP1-INDEX)  =  ZERO.
      /**************************************************************
       10410-BUILD-REC6-RUP1-TABLES.
      ***************************************************************

      *   THIS IS THE SAME CODE AS IS EXECUTED IN 10060-SET-UP-EXB,
      *   EXCEPT WITHOUT THE WRITING TO THE EXP BOOK FILE.

           PERFORM 10560-FORMAT-LINE-5.
           MOVE LOW-VALUES TO REC5-RUP-LEVEL-TABLES.
           MOVE SPACES TO REC5-RUP-CODE-TABLES.
           PERFORM 10070-SET-UP-REC5-LEVELS
               VARYING WORK-INDEX FROM 1 BY 1
               UNTIL WORK-INDEX  > MAX-RUP-LEVELS.

           PERFORM 10080-EXPAND-RUP1.

           IF  REC6-TBL-INDEX =  1
               MOVE LOW-VALUES TO REC5-RUP2-TABLE
               MOVE 1 TO RUP2-INDEX
               IF  IN-BOOK-RUP2-CODES NOT =  SPACES
                   PERFORM 10120-EXPAND-RUP2.

           MOVE REC5-RUP1-TABLE TO REC6-RUP1-TABLE (REC6-TBL-INDEX).
           PERFORM 10010-READ-IN-BOOK-FILE.
           IF  NOT END-OF-BOOK-FILE
           AND IN-BOOK-REC-TYPE  =  '6'
              PERFORM 10420-CHECK-NEW-REC6.
      /**************************************************************
       10420-CHECK-NEW-REC6.
      ***************************************************************
           IF  REC6-TBL-INDEX >  10
               DISPLAY '@@ ERROR : MORE THAN 10 TYPE 6 RECORDS @@'
               PERFORM 9990-SET-ERROR
               MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
           ELSE
               PERFORM 10430-CHECK-REC6-RUP1.
      ***************************************************************
       10430-CHECK-REC6-RUP1.
      ***************************************************************
           ADD 1 TO REC6-COUNT.
           MOVE SPACES TO REC6-LITERAL.
           MOVE REC6-LITERAL-LEVEL TO SAVE-REC6-LEVEL.
           MOVE ZERO TO REC6-LITERAL-LEVEL.
           PERFORM 10440-MATCH-REC6-RUP1-CODES
               VARYING WORK-INDEX FROM 1 BY 1
               UNTIL WORK-INDEX  >  MAX-RUP-LEVELS.
           IF  REC6-LITERAL =  SPACES
           OR REC6-LITERAL-LEVEL  =  ZERO
               DISPLAY '@@ ERROR : NO LITERAL ON RECORD TYPE 6 @@'
               DISPLAY '         REC6-LITERAL = ' REC6-LITERAL
               DISPLAY '         REC6-LEVEL   = ' REC6-LITERAL-LEVEL
               MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH
               MOVE ERRMSG-NO-REC6-LITERAL TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE
               PERFORM 9990-SET-ERROR
           ELSE
           IF  REC6-LITERAL-LEVEL NOT =  SAVE-REC6-LEVEL
           AND REC6-TBL-INDEX  >  2
               MOVE ERRMSG-UNMATCHED-REC6 TO BOOK-ERROR-MSG
               MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE
               PERFORM 9990-SET-ERROR
               DISPLAY '@@ ERROR : REC6 LITERALS MISMATCHED @@'
               MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH.
      /**************************************************************
       10440-MATCH-REC6-RUP1-CODES.
      ***************************************************************
           IF  IN-BOOK-RUP1-CODE (WORK-INDEX) NOT =
                      REC5-RUP1-CODE (WORK-INDEX)
                IF  REC6-LITERAL =  SPACES
                    MOVE IN-BOOK-RUP1-CODE (WORK-INDEX)
                              TO REC6-LITERAL
                    MOVE REC5-RUP1-LEVEL (WORK-INDEX)
                              TO REC6-LITERAL-LEVEL
                ELSE
                   MOVE ERRMSG-UNMATCHED-REC6 TO BOOK-ERROR-MSG
                   MOVE BOOK-DETAIL-LINE TO FD-PRINTER-REC
                   PERFORM 10600-WRITE-BOOK-LINE
                   PERFORM 9990-SET-ERROR
                   DISPLAY
                   '@@ ERROR : MORE THAN ONE UNMATCHED REC6 LITERAL'
                   DISPLAY '       WORK-INDEX        = '
                            WORK-INDEX
                   DISPLAY '       REC6-LITERAL      = '
                            REC6-LITERAL
                   DISPLAY '       REC6-LITERAL-LEVEL= '
                            REC6-LITERAL-LEVEL
                   DISPLAY '       IN-BOOK-RUP1-CODE = '
                            IN-BOOK-RUP1-CODE (WORK-INDEX)
                   DISPLAY '       REC5-RUP1-CODE =    '
                            REC5-RUP1-CODE (WORK-INDEX)
                   MOVE 'Y' TO BOOK-RPT-ERROR-SWITCH.
      /**************************************************************
       10470-INTERLEAVE-REC6-RUP1.
      ***************************************************************
      *    DISPLAY '10470-INTERLEAVE-REC6-RUP1'.
           PERFORM 10480-CHOOSE-REC6-ENTRIES
               VARYING REC6-TBL-INDEX FROM 1 BY 1
               UNTIL REC6-TBL-INDEX  >  REC6-COUNT.
      ***************************************************************
       10480-CHOOSE-REC6-ENTRIES.
      ***************************************************************
           IF  REC6-RUP1-ENTRY-INDEX
                (REC6-TBL-INDEX, REC6-ENTRY-INDEX)
                   NOT =   ZERO
               MOVE REC6-RUP1-ENTRY-INDEX
                        (REC6-TBL-INDEX, REC6-ENTRY-INDEX)
                  TO  REC6-WORK-ENTRY (REC6-WORK-INDEX)
               MOVE REC6-RUP1-ENTRY-LEVEL
                        (REC6-TBL-INDEX, REC6-ENTRY-INDEX)
                  TO  REC6-WORK-LEVEL (REC6-WORK-INDEX)
               ADD 1 TO REC6-WORK-INDEX.
      /**************************************************************
       10520-FORMAT-LINE-1.
      ***************************************************************
           MOVE IN-BOOK-ID TO BT1-BOOK-ID.
           MOVE IN-BOOK-ID TO BTL1-BOOK-ID.
           MOVE IN-BOOK-TITLE-MEMO TO BT1-TITLE-MEMO.
           MOVE BOOK-TABLE-LINE-1 TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
      ***************************************************************
       10530-FORMAT-LINE-2.
      ***************************************************************
           IF  LAST-BOOK-REC-TYPE NOT =  '2'
               MOVE DASH-LINE-2 TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE.
           MOVE IN-BOOK-ID TO BT2-BOOK-ID.
           MOVE IN-BOOK-PAGE-COUNT TO BT2-PAGE-COUNT.
           MOVE IN-BOOK-TOC-LINE TO BT2-TOC-LINE.
           MOVE BOOK-TABLE-LINE-2 TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
      /**************************************************************
       10540-FORMAT-LINE-3.
      ***************************************************************
           IF  LAST-BOOK-REC-TYPE NOT =  '3'
               MOVE DASH-LINE-2 TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE.
           MOVE IN-BOOK-ID TO BT3-BOOK-ID.
           MOVE IN-BOOK-PRINT-SUPP-FLAG TO BT3-PRINT-SUPP-FLAG.
           IF  IN-BOOK-PRINT-SUPP-FLAG =  SPACE
               MOVE '(NO)' TO BT3-PRINT-SUPP-MSG
           ELSE
               MOVE '(YES)' TO BT3-PRINT-SUPP-MSG.
           MOVE SPACES TO BT3-REPORT-IDS.
           MOVE IN-BOOK-REPORT-ID (1) TO BT3-REPORT-ID (1).
           MOVE IN-BOOK-REPORT-ID (2) TO BT3-REPORT-ID (2).
           MOVE IN-BOOK-REPORT-ID (3) TO BT3-REPORT-ID (3).
           MOVE IN-BOOK-REPORT-ID (4) TO BT3-REPORT-ID (4).
           MOVE IN-BOOK-REPORT-ID (5) TO BT3-REPORT-ID (5).
           MOVE IN-BOOK-REPORT-ID (6) TO BT3-REPORT-ID (6).
           MOVE IN-BOOK-REPORT-ID (7) TO BT3-REPORT-ID (7).
           MOVE IN-BOOK-REPORT-ID (8) TO BT3-REPORT-ID (8).
           MOVE IN-BOOK-REPORT-ID (9) TO BT3-REPORT-ID (9).
           MOVE IN-BOOK-REPORT-ID (10) TO BT3-REPORT-ID (10).
           MOVE IN-BOOK-REPORT-ID (11) TO BT3-REPORT-ID (11).
           MOVE IN-BOOK-REPORT-ID (12) TO BT3-REPORT-ID (12).
           MOVE IN-BOOK-REPORT-ID (13) TO BT3-REPORT-ID (13).
           MOVE IN-BOOK-REPORT-ID (14) TO BT3-REPORT-ID (14).
           MOVE IN-BOOK-REPORT-ID (15) TO BT3-REPORT-ID (15).
           MOVE IN-BOOK-REPORT-ID (16) TO BT3-REPORT-ID (16).
           MOVE IN-BOOK-REPORT-ID (17) TO BT3-REPORT-ID (17).
           MOVE IN-BOOK-REPORT-ID (18) TO BT3-REPORT-ID (18).
           MOVE BOOK-TABLE-LINE-3-1 TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
           MOVE BOOK-TABLE-LINE-3-2 TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
      /**************************************************************
       10550-FORMAT-LINE-4.
      ***************************************************************
           MOVE IN-BOOK-ID TO BT4-BOOK-ID.
           MOVE SPACES TO BT4-RUP1-MNEMONICS.
           IF  BOOK-RUP1-TYPE =  'P'
               MOVE IN-BOOK-RUP1-PRIME (1) TO BT4-RUP1-MNEM (1)
               MOVE IN-BOOK-RUP1-PRIME (2) TO BT4-RUP1-MNEM (2)
               MOVE IN-BOOK-RUP1-PRIME (3) TO BT4-RUP1-MNEM (3)
               MOVE IN-BOOK-RUP1-PRIME (4) TO BT4-RUP1-MNEM (4)
               MOVE IN-BOOK-RUP1-PRIME (5) TO BT4-RUP1-MNEM (5)
               MOVE IN-BOOK-RUP1-PRIME (6) TO BT4-RUP1-MNEM (6)
               MOVE IN-BOOK-RUP1-PRIME (7) TO BT4-RUP1-MNEM (7)
               MOVE IN-BOOK-RUP1-PRIME (8) TO BT4-RUP1-MNEM (8)
           ELSE
               MOVE IN-BOOK-RUP1-MNEM (1) TO BT4-RUP1-MNEM (1)
               MOVE IN-BOOK-RUP1-MNEM (2) TO BT4-RUP1-MNEM (2)
               MOVE IN-BOOK-RUP1-MNEM (3) TO BT4-RUP1-MNEM (3)
               MOVE IN-BOOK-RUP1-MNEM (4) TO BT4-RUP1-MNEM (4)
               MOVE IN-BOOK-RUP1-MNEM (5) TO BT4-RUP1-MNEM (5)
               MOVE IN-BOOK-RUP1-MNEM (6) TO BT4-RUP1-MNEM (6)
               MOVE IN-BOOK-RUP1-MNEM (7) TO BT4-RUP1-MNEM (7)
               MOVE IN-BOOK-RUP1-MNEM (8) TO BT4-RUP1-MNEM (8)
               MOVE IN-BOOK-RUP1-MNEM (9) TO BT4-RUP1-MNEM (9)
               MOVE IN-BOOK-RUP1-MNEM (10) TO BT4-RUP1-MNEM (10)
               MOVE IN-BOOK-RUP1-MNEM (11) TO BT4-RUP1-MNEM (11).
           MOVE BOOK-TABLE-LINE-4-1 TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
           IF  IN-BOOK-RUP2-MNEMONICS NOT =  SPACES
               IF  BOOK-RUP2-TYPE =  'P'
                   MOVE IN-BOOK-RUP2-PRIME (1) TO BT4-RUP2-MNEM (1)
                   MOVE IN-BOOK-RUP2-PRIME (2) TO BT4-RUP2-MNEM (2)
                   MOVE IN-BOOK-RUP2-PRIME (3) TO BT4-RUP2-MNEM (3)
                   MOVE IN-BOOK-RUP2-PRIME (4) TO BT4-RUP2-MNEM (4)
                   MOVE IN-BOOK-RUP2-PRIME (5) TO BT4-RUP2-MNEM (5)
                   MOVE IN-BOOK-RUP2-PRIME (6) TO BT4-RUP2-MNEM (6)
                   MOVE IN-BOOK-RUP2-PRIME (7) TO BT4-RUP2-MNEM (7)
                   MOVE IN-BOOK-RUP2-PRIME (8) TO BT4-RUP2-MNEM (8)
               ELSE
                   MOVE IN-BOOK-RUP2-MNEM (1) TO BT4-RUP2-MNEM (1)
                   MOVE IN-BOOK-RUP2-MNEM (2) TO BT4-RUP2-MNEM (2)
                   MOVE IN-BOOK-RUP2-MNEM (3) TO BT4-RUP2-MNEM (3)
                   MOVE IN-BOOK-RUP2-MNEM (4) TO BT4-RUP2-MNEM (4)
                   MOVE IN-BOOK-RUP2-MNEM (5) TO BT4-RUP2-MNEM (5)
                   MOVE IN-BOOK-RUP2-MNEM (6) TO BT4-RUP2-MNEM (6)
                   MOVE IN-BOOK-RUP2-MNEM (7) TO BT4-RUP2-MNEM (7)
                   MOVE IN-BOOK-RUP2-MNEM (8) TO BT4-RUP2-MNEM (8)
                   MOVE IN-BOOK-RUP2-MNEM (9) TO BT4-RUP2-MNEM (9)
                   MOVE IN-BOOK-RUP2-MNEM (10) TO BT4-RUP2-MNEM (10)
                   MOVE IN-BOOK-RUP2-MNEM (11) TO BT4-RUP2-MNEM (11)
                   MOVE BOOK-TABLE-LINE-4-2 TO FD-PRINTER-REC
                   PERFORM 10600-WRITE-BOOK-LINE.
      /**************************************************************
       10560-FORMAT-LINE-5.
      ***************************************************************
           MOVE IN-BOOK-ID TO BT5-BOOK-ID.
           MOVE SPACES TO BT5-RUP1-CODES.
           MOVE IN-BOOK-REC-TYPE TO BT5-REC-TYPE.
           MOVE IN-BOOK-RUP1-CODE (1) TO BT5-RUP1-CODE (1).
           MOVE IN-BOOK-RUP1-CODE (2) TO BT5-RUP1-CODE (2).
           MOVE IN-BOOK-RUP1-CODE (3) TO BT5-RUP1-CODE (3).
           MOVE IN-BOOK-RUP1-CODE (4) TO BT5-RUP1-CODE (4).
           MOVE IN-BOOK-RUP1-CODE (5) TO BT5-RUP1-CODE (5).
           MOVE IN-BOOK-RUP1-CODE (6) TO BT5-RUP1-CODE (6).
           MOVE IN-BOOK-RUP1-CODE (7) TO BT5-RUP1-CODE (7).
           MOVE IN-BOOK-RUP1-CODE (8) TO BT5-RUP1-CODE (8).
           MOVE IN-BOOK-RUP1-CODE (9) TO BT5-RUP1-CODE (9).
           MOVE IN-BOOK-RUP1-CODE (10) TO BT5-RUP1-CODE (10).
           MOVE IN-BOOK-RUP1-CODE (11) TO BT5-RUP1-CODE (11).
           MOVE IN-BOOK-RUP1-SUPP (1) TO BT5-RUP1-SUPP (1).
           MOVE IN-BOOK-RUP1-SUPP (2) TO BT5-RUP1-SUPP (2).
           MOVE IN-BOOK-RUP1-SUPP (3) TO BT5-RUP1-SUPP (3).
           MOVE IN-BOOK-RUP1-SUPP (4) TO BT5-RUP1-SUPP (4).
           MOVE IN-BOOK-RUP1-SUPP (5) TO BT5-RUP1-SUPP (5).
           MOVE IN-BOOK-RUP1-SUPP (6) TO BT5-RUP1-SUPP (6).
           MOVE IN-BOOK-RUP1-SUPP (7) TO BT5-RUP1-SUPP (7).
           MOVE IN-BOOK-RUP1-SUPP (8) TO BT5-RUP1-SUPP (8).
           MOVE IN-BOOK-RUP1-SUPP (9) TO BT5-RUP1-SUPP (9).
           MOVE IN-BOOK-RUP1-SUPP (10) TO BT5-RUP1-SUPP (10).
           MOVE IN-BOOK-RUP1-SUPP (11) TO BT5-RUP1-SUPP (11).
           MOVE BOOK-TABLE-LINE-5-1 TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
           MOVE SPACES TO BT5-RUP2-CODES.
           IF  IN-BOOK-RUP2-CODES NOT =  SPACES
               MOVE IN-BOOK-RUP2-CODE (1) TO BT5-RUP2-CODE (1)
               MOVE IN-BOOK-RUP2-CODE (2) TO BT5-RUP2-CODE (2)
               MOVE IN-BOOK-RUP2-CODE (3) TO BT5-RUP2-CODE (3)
               MOVE IN-BOOK-RUP2-CODE (4) TO BT5-RUP2-CODE (4)
               MOVE IN-BOOK-RUP2-CODE (5) TO BT5-RUP2-CODE (5)
               MOVE IN-BOOK-RUP2-CODE (6) TO BT5-RUP2-CODE (6)
               MOVE IN-BOOK-RUP2-CODE (7) TO BT5-RUP2-CODE (7)
               MOVE IN-BOOK-RUP2-CODE (8) TO BT5-RUP2-CODE (8)
               MOVE IN-BOOK-RUP2-CODE (9) TO BT5-RUP2-CODE (9)
               MOVE IN-BOOK-RUP2-CODE (10) TO BT5-RUP2-CODE (10)
               MOVE IN-BOOK-RUP2-CODE (11) TO BT5-RUP2-CODE (11)
               MOVE IN-BOOK-RUP2-SUPP (1) TO BT5-RUP2-SUPP (1)
               MOVE IN-BOOK-RUP2-SUPP (2) TO BT5-RUP2-SUPP (2)
               MOVE IN-BOOK-RUP2-SUPP (3) TO BT5-RUP2-SUPP (3)
               MOVE IN-BOOK-RUP2-SUPP (4) TO BT5-RUP2-SUPP (4)
               MOVE IN-BOOK-RUP2-SUPP (5) TO BT5-RUP2-SUPP (5)
               MOVE IN-BOOK-RUP2-SUPP (6) TO BT5-RUP2-SUPP (6)
               MOVE IN-BOOK-RUP2-SUPP (7) TO BT5-RUP2-SUPP (7)
               MOVE IN-BOOK-RUP2-SUPP (8) TO BT5-RUP2-SUPP (8)
               MOVE IN-BOOK-RUP2-SUPP (9) TO BT5-RUP2-SUPP (9)
               MOVE IN-BOOK-RUP2-SUPP (10) TO BT5-RUP2-SUPP (10)
               MOVE IN-BOOK-RUP2-SUPP (11) TO BT5-RUP2-SUPP (11)
               MOVE BOOK-TABLE-LINE-5-2 TO FD-PRINTER-REC
               PERFORM 10600-WRITE-BOOK-LINE.
      /**************************************************************
       10570-FORMAT-ERROR-LINE.
      ***************************************************************
           MOVE IN-BOOK-REC TO BTE-LINE.
           MOVE BOOK-TABLE-ERROR-LINE TO FD-PRINTER-REC.
           PERFORM 10600-WRITE-BOOK-LINE.
      /**************************************************************
       10600-WRITE-BOOK-LINE.
      ***************************************************************
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           ADD 1 TO LINE-COUNT.
           IF  LINE-COUNT >  59
                PERFORM 10650-PRINT-BOOK-HEADINGS.
      ***************************************************************
       10650-PRINT-BOOK-HEADINGS.
      ***************************************************************
           ADD 1 TO PAGE-COUNT.
           MOVE PAGE-COUNT TO H-PAGE.
           WRITE FD-PRINTER-REC FROM HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER-REC FROM HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE BOOK-TITLE TO H-TITLE.
           WRITE FD-PRINTER-REC FROM HEADING-3
               AFTER ADVANCING 1 LINES.
           MOVE BH3-TABLE-TITLE TO BH3-TITLE.
           WRITE FD-PRINTER-REC FROM BOOK-HEADING-3
               AFTER ADVANCING 2 LINES.
           WRITE FD-PRINTER-REC FROM DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER-REC.
           WRITE FD-PRINTER-REC
               AFTER ADVANCING 1 LINES.
           MOVE 10 TO LINE-COUNT.
      /**************************************************************
       10900-WRITE-BOOK-LINE.
      ***************************************************************
           WRITE FD-PRINTER2-REC
               AFTER ADVANCING 1 LINES.
           ADD 1 TO LINE-COUNT-2.
           IF  LINE-COUNT-2 >  59
                PERFORM 10950-PRINT-BOOK-HEADINGS.
      ***************************************************************
       10950-PRINT-BOOK-HEADINGS.
      ***************************************************************
           ADD 1 TO PAGE-COUNT-2.
           MOVE PAGE-COUNT-2 TO H-PAGE.
           MOVE SAVE-BOOK-ID TO H-BOOK-ID.
           WRITE FD-PRINTER2-REC FROM HEADING-1
               AFTER ADVANCING PAGE.
           MOVE BOOK-TITLE TO H-TITLE.
           WRITE FD-PRINTER2-REC FROM HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER2-REC FROM BOOK-HEADING-1
               AFTER ADVANCING 2 LINES.
           IF  BOOK-TITLE-FLAG =  'M'
               MOVE BH3-MEMO-TITLE TO BH3-TITLE
           ELSE
           IF  BOOK-TITLE-FLAG =  'T'
               MOVE BH3-TOC-TITLE TO BH3-TITLE
           ELSE
               MOVE SPACES TO BH3-TITLE.
           WRITE FD-PRINTER2-REC FROM BOOK-HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER2-REC FROM DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER2-REC.
           WRITE FD-PRINTER2-REC
               AFTER ADVANCING 1 LINES.
           MOVE 12 TO LINE-COUNT-2.
      /**************************************************************
       11000-EDIT-DISTRIBUTION-TABLE.
      ***************************************************************
           MOVE ZERO TO PAGE-COUNT-2.
           PERFORM 11010-PRINT-BOOK-DIST-XREF
               VARYING BDX-INDEX FROM 1 BY 1
               UNTIL   BDX-INDEX  >  MAX-BDX
                  OR   BDX-TABLE-ENTRY (BDX-INDEX)  =  HIGH-VALUES.
           OPEN INPUT IN-DIST-FILE.
           MOVE SPACES TO IN-DIST-FILE-STATUS.
           PERFORM 1020-READ-IN-DIST-FILE.
           IF  NOT END-OF-DIST-FILE
               PERFORM 11100-PRINT-DIST-FILE
                   UNTIL  END-OF-DIST-FILE.
           CLOSE IN-DIST-FILE.
      ***************************************************************
       11010-PRINT-BOOK-DIST-XREF.
      ***************************************************************
           PERFORM 11060-PRINT-DIST-HEADINGS.
           MOVE SPACES TO DIST-BOOK-LINE-1.
           SET BOOK-INDEX TO BDX-INDEX.
           MOVE BDX-TBL-BOOK-ID (BDX-INDEX) TO DB-BOOK-ID.
           MOVE SPACES TO DB-BOOK-ERROR-MSG.
           MOVE DIST-BOOK-LINE-1 TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE SPACES TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE DIST-BOOK-LINE-2 TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE SPACES TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           PERFORM 11020-PRINT-DISTRIBUTEES
               VARYING BDX-DIST-INDEX FROM 1 BY 1
               UNTIL   BDX-DIST-INDEX  >  MAX-DISTRIBUTEES
                  OR   BDX-DIST-X (BDX-INDEX, BDX-DIST-INDEX)
                              =   HIGH-VALUES.
      ***************************************************************
       11020-PRINT-DISTRIBUTEES.
      ***************************************************************
           MOVE BDX-TABLE-DIST (BDX-INDEX, BDX-DIST-INDEX)
                  TO DIST-INDEX.
           MOVE DIST-NAME (DIST-INDEX) TO DB-DIST-NAME.
           MOVE DIST-BOOK-LINE-3 TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE SPACES TO DB-DIST-NAME.
      /**************************************************************
       11050-WRITE-DIST-LINE.
      ***************************************************************
           WRITE FD-PRINTER2-REC
               AFTER ADVANCING 1 LINES.
           ADD 1 TO LINE-COUNT-2.
           IF  LINE-COUNT-2 >  59
                PERFORM 11060-PRINT-DIST-HEADINGS.
      ***************************************************************
       11060-PRINT-DIST-HEADINGS.
      ***************************************************************
           ADD 1 TO PAGE-COUNT-2.
           MOVE PAGE-COUNT-2 TO H-PAGE.
           WRITE FD-PRINTER2-REC FROM HEADING-1
               AFTER ADVANCING PAGE.
           WRITE FD-PRINTER2-REC FROM HEADING-2
               AFTER ADVANCING 1 LINES.
           MOVE DIST-TITLE TO H-TITLE.
           WRITE FD-PRINTER2-REC FROM HEADING-3
               AFTER ADVANCING 1 LINES.
           WRITE FD-PRINTER2-REC FROM DASH-LINE
               AFTER ADVANCING 1 LINES.
           MOVE SPACES TO FD-PRINTER2-REC.
           WRITE FD-PRINTER2-REC
               AFTER ADVANCING 1 LINES.
           MOVE 12 TO LINE-COUNT-2.
      /**************************************************************
       11100-PRINT-DIST-FILE.
      ***************************************************************
           IF  IN-DIST-REC-TYPE =  '1'
               PERFORM 11060-PRINT-DIST-HEADINGS
               PERFORM 11120-PRINT-DIST-NAME
           ELSE
           IF  IN-DIST-REC-TYPE =  '2'
               PERFORM 11110-PRINT-BOOK-TITLES
                   VARYING DIST-BOOK-INDEX FROM 1 BY 1
                   UNTIL DIST-BOOK-INDEX  >  MAX-BOOKS-ON-DIST-DEF
                      OR IN-DIST-BOOK-ID (DIST-BOOK-INDEX)
                              =  SPACES
           ELSE
               MOVE IN-DIST-REC TO DIST-ERROR-REC-AREA
               MOVE DIST-ERROR-LINE TO FD-PRINTER2-REC
               PERFORM 11050-WRITE-DIST-LINE
               MOVE SPACES TO DIST-ERROR-LINE
               MOVE ERRMSG-INVALID-DIST-REC-TYPE TO DIST-ERROR-MSG
               MOVE DIST-ERROR-LINE TO FD-PRINTER2-REC
               PERFORM 11050-WRITE-DIST-LINE
      *        MOVE 12 TO RETURN-CODE
               ADD 1 TO ERROR-COUNT

               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-2
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-3
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  IN-DIST-REC
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  FD-PRINTER2-REC
                   AFTER ADVANCING 1 LINES
               MOVE ALL '-' TO FD-ERROR-AREA
               WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE
           END-IF.
           PERFORM 1020-READ-IN-DIST-FILE.
      /**************************************************************
       11110-PRINT-BOOK-TITLES.
      ***************************************************************
           MOVE SPACES TO DIST-BOOK-LINE-1.
           MOVE IN-DIST-BOOK-ID (DIST-BOOK-INDEX) TO DB-BOOK-ID.
           SEARCH ALL BDX-TABLE-ENTRIES
               AT END
                   MOVE ERRMSG-UNDEFINED-BOOK TO DB-BOOK-ERROR-MSG
      *            MOVE 12 TO RETURN-CODE
                   ADD 1 TO ERROR-COUNT

               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-2
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-3
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  FD-PRINTER-REC
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  DB-BOOK-ERROR-MSG
                   AFTER ADVANCING 1 LINES
               MOVE ALL '-' TO FD-ERROR-AREA
               WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE

               WHEN BDX-TBL-BOOK-ID (BDX-INDEX)  =  DB-BOOK-ID
                   SET WORK-INDEX TO BDX-INDEX
                   MOVE SPACES TO DB-BOOK-ERROR-MSG.
           MOVE SPACES TO DB-BOOK-BURST-MSG.
           IF  IN-DIST-BURST-FLAG (DIST-BOOK-INDEX) NOT = SPACE
               MOVE '* BURST *' TO DB-BOOK-BURST-MSG.
           MOVE 'COPIES : ' TO DB-BOOK-COPIES-MSG.
           IF  IN-DIST-BOOK-COPIES (DIST-BOOK-INDEX) IS NOT NUMERIC
               MOVE ERRMSG-NON-NUMERIC-COPIES TO DB-BOOK-ERROR-MSG
               MOVE IN-DIST-BOOK-COPIES-X (DIST-BOOK-INDEX)
                   TO  DB-BOOK-COPIES-X

               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-2
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-3
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  FD-PRINTER-REC
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  DB-BOOK-ERROR-MSG
                   AFTER ADVANCING 1 LINES
               MOVE ALL '-' TO FD-ERROR-AREA
               WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE

      *        MOVE 12 TO RETURN-CODE
               ADD 1 TO ERROR-COUNT
           ELSE
               MOVE IN-DIST-BOOK-COPIES (DIST-BOOK-INDEX)
                   TO  DB-BOOK-COPIES
               IF  IN-DIST-BOOK-COPIES (DIST-BOOK-INDEX)
                         IS GREATER THAN  MAX-BOOK-COPIES
                   MOVE ERRMSG-OVER-MAX-COPIES TO DB-BOOK-ERROR-MSG

               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-2
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-3
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  FD-PRINTER-REC
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  DB-BOOK-ERROR-MSG
                   AFTER ADVANCING 1 LINES
               MOVE ALL '-' TO FD-ERROR-AREA
               WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE

      *            MOVE 12 TO RETURN-CODE
                   ADD 1 TO ERROR-COUNT.
           IF  BOOK-EXISTS-FLAG (WORK-INDEX) NOT =  'Y'
               MOVE ERRMSG-UNDEFINED-BOOK TO DB-BOOK-ERROR-MSG
      *        MOVE 12 TO RETURN-CODE
               ADD 1 TO ERROR-COUNT

               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-2
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM BOOK-HEADING-3
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  FD-PRINTER-REC
                   AFTER ADVANCING 1 LINES
               WRITE FD-ERRORS-REC  FROM  DB-BOOK-ERROR-MSG
                   AFTER ADVANCING 1 LINES
               MOVE ALL '-' TO FD-ERROR-AREA
               WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE
           END-IF.
           MOVE DIST-BOOK-LINE-1 TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
      ***************************************************************
       11120-PRINT-DIST-NAME.
      ***************************************************************
           MOVE IN-DIST-NAME TO DB-DIST-NAME.
           MOVE DIST-BOOK-LINE-3 TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE SPACES TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE DIST-BOOK-LINE-4 TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
           MOVE SPACES TO FD-PRINTER2-REC.
           PERFORM 11050-WRITE-DIST-LINE.
      /**************************************************************
       12000-WRITE-INTERNAL-TABLES.
      ***************************************************************
           SORT SORT-FILE ON ASCENDING   SD-EXB-KEY
               USING EXP-BOOK-DEF-FILE
               OUTPUT PROCEDURE IS 12005-COPY-EXB-RECS
                             THRU  12009-EXIT.

           SORT SORT-FILE ON ASCENDING   SD-ORC-KEY
               INPUT  PROCEDURE IS 12010-BUILD-ORC-SORT-RECS
                             THRU  12029-EXIT
               OUTPUT PROCEDURE IS 12030-SUMMARIZE-ORC-RECS
                             THRU  12059-EXIT.

           CLOSE CALC-WORK-FILE.
           SORT SORT-FILE ON ASCENDING   SD-CALC-KEY
               USING CALC-WORK-FILE
               OUTPUT PROCEDURE IS 12100-SUMMARIZE-CALC-RECS
                             THRU  12199-EXIT.
           MOVE OCF-COUNT TO CTR-OCF.
           MOVE RCF-COUNT TO CTR-RCF.
           MOVE PCF-COUNT TO CTR-PCF.
           MOVE EXB-COUNT TO CTR-EXB.
      *    DISPLAY '** OCF-COUNT = ' OCF-COUNT.
      *    DISPLAY '** RCF-COUNT = ' RCF-COUNT.
      *    DISPLAY '** PCF-COUNT = ' PCF-COUNT.

           OPEN OUTPUT RPT-DEF-FILE.
           PERFORM 12200-WRITE-RPT-DEFS
               VARYING REPORT-INDEX  FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                            =  HIGH-VALUES.
           CLOSE RPT-DEF-FILE.
           MOVE RDF-COUNT TO CTR-RDF.

           PERFORM 12240-CHECK-PXT-USAGE-FLAGS
               VARYING PRIME-INDEX FROM MAX-PRIME BY -1
               UNTIL  PRIME-INDEX  =  ZERO.

           OPEN OUTPUT PRIME-XREF-TBL-FILE.
           PERFORM 12250-WRITE-PXT-RECORD
               VARYING PRIME-INDEX FROM 1 BY 1
               UNTIL  PRIME-INDEX  >  MAX-PRIME
                  OR  PRIME-TBL-ID (PRIME-INDEX)  =  LOW-VALUES.
           CLOSE PRIME-XREF-TBL-FILE.
           MOVE PXT-COUNT TO CTR-PXT.

           IF  PRIME-INDEX > MAX-PRIME
               DISPLAY '@@ ERROR - PRIME COUNT OVER 5000 @@'
               DISPLAY '@@  INCREASE TABLE SIZE   @@'
               MOVE '@@ ERROR - PRIME COUNT OVER 5000 @@'
                 TO W9999-ERROR-MESSAGE-1
               MOVE '@@  INCREASE TABLE SIZE   @@'
                 TO W9999-ERROR-MESSAGE-2
               PERFORM 99999-ABORT
           END-IF.

           OPEN OUTPUT ORG-TABLE-FILE.
           PERFORM 12300-PROCESS-ORG-OTF
               VARYING ORG-ID-INDEX FROM 1 BY 1
               UNTIL  ORG-ID-INDEX  >  MAX-ORG-ID.
           CLOSE ORG-TABLE-FILE.
      *    DISPLAY 'NUMBER OF OTF RECORDS = ' OTF-COUNT.
           MOVE OTF-COUNT TO CTR-OTF.

           OPEN OUTPUT REG-TABLE-FILE.
           PERFORM 12400-PROCESS-REG-RTF
               VARYING REG-ID-INDEX FROM 1 BY 1
               UNTIL  REG-ID-INDEX  >  MAX-REG-ID.
           CLOSE REG-TABLE-FILE.
      *    DISPLAY 'NUMBER OF RTF RECORDS = ' RTF-COUNT.
           MOVE RTF-COUNT TO CTR-RTF.

           SORT SORT-FILE ON ASCENDING   SD-TCM-KEY
               USING TBL-OF-CONT-FILE
               OUTPUT PROCEDURE IS 12500-COPY-TCM-RECS
                             THRU  12599-EXIT.
           MOVE TCM-COUNT TO CTR-TCM.
           PERFORM 12600-PROCESS-COUNTERS.
      /**************************************************************
       12005-COPY-EXB-RECS.
      ***************************************************************
           OPEN OUTPUT EXP-BOOK-DEF-FILE.
           MOVE SPACES TO SORT-FILE-STATUS.
           PERFORM 12006-RETURN-SD-EXB-REC.
           IF  NOT END-OF-SORT-FILE
               PERFORM 12007-WRITE-EXB-RECS
                   UNTIL END-OF-SORT-FILE.
           CLOSE EXP-BOOK-DEF-FILE.
           GO TO 12009-EXIT.
      ***************************************************************
       12006-RETURN-SD-EXB-REC.
      ***************************************************************
           RETURN SORT-FILE INTO EXB-RECORD
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ***************************************************************
       12007-WRITE-EXB-RECS.
      ***************************************************************
           WRITE FD-EXP-BOOK-DEF-FILE-REC  FROM  EXB-RECORD.
           PERFORM 12006-RETURN-SD-EXB-REC.
           ADD 1 TO EXB-COUNT.
      ***************************************************************
       12009-EXIT.
      ***************************************************************
           EXIT.
      /**************************************************************
       12010-BUILD-ORC-SORT-RECS.
      ***************************************************************
           PERFORM 12020-SCAN-REPORTS
               VARYING  REPORT-INDEX FROM 1 BY 1
               UNTIL  REPORT-INDEX  >  MAX-RDT
                  OR  REPORT-TABLE-ENTRY (REPORT-INDEX)
                           =  HIGH-VALUES.
           GO TO 12029-EXIT.
      ***************************************************************
       12020-SCAN-REPORTS.
      ***************************************************************
           MOVE HIGH-VALUES TO SD-ORC-REC.
           MOVE '1' TO SD-ORC-REC-TYPE.
           MOVE RDT-REG-ID-INDEX (REPORT-INDEX)
               TO   SD-ORC-REG-ID-INDEX.
           MOVE REG-TOT-ENTRY (SD-ORC-REG-ID-INDEX)
               TO   SD-ORC-ORG-ID-INDEX.
           RELEASE SD-ORC-REC.
           MOVE HIGH-VALUES TO SD-ORC-REC.
           MOVE '2' TO SD-ORC-REC-TYPE.
           MOVE RDT-ORG-ID-INDEX (REPORT-INDEX)
               TO   SD-ORC-ORG-ID-INDEX.
           MOVE RDT-REG-ID-INDEX (REPORT-INDEX)
               TO   SD-ORC-REG-ID-INDEX.
           RELEASE SD-ORC-REC.
      *    MOVE HIGH-VALUES TO SD-ORC-REC.
      *    MOVE '3' TO SD-ORC-REC-TYPE.
      *    MOVE REPORT-TABLE-ENTRY (REPORT-INDEX) TO RDF-RECORD.
      *    MOVE 'N' TO FCST-PLAN-FLAG.
      *    PERFORM 12025-CHECK-FCST-PLAN
      *        VARYING  WORK-INDEX FROM 1 BY 1
      *        UNTIL  WORK-INDEX  >  MAX-COL
      *           OR  FCST-PLAN-FLAG  =  'Y'.
      *    IF FCST-PLAN-FLAG  =  'Y'
      *        MOVE RDF-REG-ID-INDEX TO SD-ORC-REG-ID-INDEX
      *        MOVE RDF-ORG-ID-INDEX TO SD-ORC-ORG-ID-INDEX
      *        RELEASE SD-ORC-REC.
      ***************************************************************
      *12025-CHECK-FCST-PLAN.
      ***************************************************************
      *     MOVE RDF-PERIOD-MNEMONIC (WORK-INDEX)
      *         TO  PER-MNEM-WORK.
      *     IF PER-MNEM-1  =  'F'  OR  'P'
      *         MOVE 'Y' TO FCST-PLAN-FLAG.
      ***************************************************************
       12029-EXIT.
      ***************************************************************
            EXIT.
      /**************************************************************
       12030-SUMMARIZE-ORC-RECS.
      ***************************************************************
           OPEN OUTPUT ORG-REG-COMBO-FILE.
           MOVE SPACES TO SORT-FILE-STATUS.
           PERFORM 12040-RETURN-SD-ORC-REC.
           MOVE HIGH-VALUES TO ORC-RECORD.
           MOVE SD-ORC-REC-TYPE TO SAVE-ORC-REC-TYPE.
           SET ORC-IX TO 1.
           PERFORM 12050-CHECK-ORC-KEY
               UNTIL  END-OF-SORT-FILE.
           WRITE FD-ORG-REG-COMBO-FILE-REC  FROM  ORC-RECORD.
           PERFORM 12055-WRITE-ORF.
           MOVE ORC-COUNT TO CTR-ORC.
           CLOSE ORG-REG-COMBO-FILE.
           GO TO 12059-EXIT.
      ******************************************************************
       12040-RETURN-SD-ORC-REC.
      ******************************************************************
           RETURN SORT-FILE
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       12050-CHECK-ORC-KEY.
      ******************************************************************
           IF  SD-ORC-REC-TYPE NOT =  SAVE-ORC-REC-TYPE
               PERFORM 12055-WRITE-ORF
               MOVE HIGH-VALUES TO ORC-RECORD
               SET ORC-IX TO 1
               MOVE LOW-VALUES TO SAVE-ORC-KEY.
           IF  SD-ORC-ORG-REG NOT =  SAVE-ORC-ORG-REG
               MOVE SD-ORC-ORG-ID-INDEX TO
                       ORC-ORG-ID-INDEX (ORC-IX)
               MOVE SD-ORC-REG-ID-INDEX TO
                       ORC-REG-ID-INDEX (ORC-IX)
               SET ORC-IX UP BY 1
               MOVE SD-ORC-KEY TO SAVE-ORC-KEY.
           PERFORM 12040-RETURN-SD-ORC-REC.
      ******************************************************************
       12055-WRITE-ORF.
      ******************************************************************
           WRITE FD-ORG-REG-COMBO-FILE-REC FROM ORC-RECORD.
           ADD 1 TO ORC-COUNT.
      ******************************************************************
       12059-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       12100-SUMMARIZE-CALC-RECS.
      ******************************************************************
           OPEN OUTPUT ORG-CALC-FILE
                       REG-CALC-FILE
                       PRIME-CALC-FILE.
           MOVE SPACES TO SORT-FILE-STATUS.
           PERFORM 12110-RETURN-CALC-SORT-REC.
           PERFORM 12180-SET-UP-NEW-REC.
           PERFORM 12120-COMBINE-CALC-RECS
               UNTIL  END-OF-SORT-FILE.
           PERFORM 12140-CHECK-CALC-WRITE.
           CLOSE ORG-CALC-FILE
                 REG-CALC-FILE
                 PRIME-CALC-FILE.
           GO TO 12199-EXIT.
      /*****************************************************************
       12110-RETURN-CALC-SORT-REC.
      ******************************************************************
           RETURN SORT-FILE  INTO  CALC-WORK-RECORD
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ******************************************************************
       12120-COMBINE-CALC-RECS.
      ******************************************************************
           IF  CALC-BREAK-KEY NOT =  SAVE-CALC-BREAK-KEY
               PERFORM 12140-CHECK-CALC-WRITE
               PERFORM 12180-SET-UP-NEW-REC.
           PERFORM 12130-CHECK-CALC-REC-TYPE.
           PERFORM 12110-RETURN-CALC-SORT-REC.
      ******************************************************************
       12130-CHECK-CALC-REC-TYPE.
      ******************************************************************
      *  COMMENTS : THE PRIME CALC RECORD FORMAT IS USED AS A WORK
      *    AREA ONLY; THE FORMATS OF THE ORG, REG AND PRIME CALC
      *    RECORDS ARE EXACTLY THE SAME.
      ******************************************************************
      *
           IF  PCF-IX > MAX-CALC-ENTRIES
               DISPLAY ERRMSG-CALC-FILE-OVERFLOW UPON CONSOLE
               MOVE ERRMSG-CALC-FILE-OVERFLOW
                 TO W9999-ERROR-MESSAGE-1
               GO TO 99999-ABORT.
           IF  CALC-REC-REPORT-INDEX NOT =
                             SAVE-CALC-REC-REPORT-INDEX
               MOVE 'R' TO PCF-FLAG (PCF-IX)
               MOVE CALC-REC-REPORT-INDEX TO PCF-INDEX (PCF-IX)
               MOVE CALC-REC-REPORT-INDEX TO
                       SAVE-CALC-REC-REPORT-INDEX
               IF  CALC-REC-LCP-FLAG =  '1'  OR  '2'
                   MOVE CALC-REC-LCP-FLAG TO PCF-FLAG (PCF-IX)
                   SET PCF-IX UP BY 1
               ELSE
                   SET PCF-IX UP BY 1.

           IF  CALC-REC-LCP-FLAG =  'L'
               MOVE 'L' TO PCF-FLAG (PCF-IX)
               MOVE CALC-REC-LINE-COL-NO TO PCF-INDEX (PCF-IX)
               SET PCF-IX UP BY 1
               MOVE CALC-REC-REL-CALC TO PCF-INDEX (PCF-IX)
               SET PCF-IX UP BY 1
           ELSE
           IF  CALC-REC-LCP-FLAG =  'C'
               MOVE CALC-REC-OPERATOR TO PCF-FLAG (PCF-IX)
               MOVE CALC-REC-LINE-COL-NO TO PCF-INDEX (PCF-IX)
               SET PCF-IX UP BY 1.
      /*****************************************************************
       12140-CHECK-CALC-WRITE.
      ******************************************************************
           SET PCF-ENTRY-COUNT TO PCF-IX.
           SUBTRACT 1 FROM PCF-ENTRY-COUNT.
           IF  SAVE-CALC-REC-TYPE =  'P'
               PERFORM 12150-WRITE-PRIME-CALC-REC
           ELSE
           IF  SAVE-CALC-REC-TYPE =  'R'
               PERFORM 12160-WRITE-REG-CALC-REC
           ELSE
           IF  SAVE-CALC-REC-TYPE =  'O'
               PERFORM 12170-WRITE-ORG-CALC-REC
           ELSE
              DISPLAY ' UNKNOWN REC-TYPE 12140-:' SAVE-CALC-REC-TYPE.
      ******************************************************************
       12150-WRITE-PRIME-CALC-REC.
      ******************************************************************
      *    DISPLAY ' PRIME CALC REC INDEX = ' PCF-REL-REC.
           MOVE PCF-REL-REC TO REL-REC-PCF PCF-COUNT.
           WRITE FD-PCF-REC FROM  PCF-RECORD.
      *    ADD 1 TO PCF-COUNT.
      ******************************************************************
       12160-WRITE-REG-CALC-REC.
      ******************************************************************
      *    DISPLAY ' REG CALC REC INDEX = ' PCF-REL-REC.
           MOVE PCF-REL-REC TO REL-REC-RCF RCF-COUNT.
           WRITE FD-RCF-REC  FROM  PCF-RECORD.
      *    ADD 1 TO RCF-COUNT.
      ******************************************************************
       12170-WRITE-ORG-CALC-REC.
      ******************************************************************
      *    DISPLAY ' ORG CALC REC INDEX = ' PCF-REL-REC.
           MOVE PCF-REL-REC TO REL-REC-OCF OCF-COUNT.
           WRITE FD-OCF-REC  FROM  PCF-RECORD.
      *    ADD 1 TO OCF-COUNT.
      /*****************************************************************
       12180-SET-UP-NEW-REC.
      ******************************************************************
           MOVE CALC-WORK-KEY TO SAVE-CALC-WORK-KEY.
           MOVE ZERO TO SAVE-CALC-REC-REPORT-INDEX.
           MOVE LOW-VALUES TO PCF-RECORD.
           MOVE CALC-REC-REL-REC TO PCF-REL-REC.
           SET PCF-IX TO 1.
      ******************************************************************
       12199-EXIT.
      ******************************************************************
           EXIT.
      /*****************************************************************
       12200-WRITE-RPT-DEFS.
      ******************************************************************
           WRITE FD-RPT-DEF-FILE-REC
                FROM  REPORT-TABLE-ENTRY (REPORT-INDEX).
           ADD 1 TO RDF-COUNT.

      ******************************************************************
       12240-CHECK-PXT-USAGE-FLAGS.
      ******************************************************************
           IF  PRIME-TBL-USAGE-FLAG (PRIME-INDEX) =  LOW-VALUES
               MOVE SPACE TO PRIME-TBL-USAGE-FLAG (PRIME-INDEX).
           PERFORM 12245-SET-SUBTOTAL-FLAGS
               VARYING PRIME-SUB-INDEX FROM 1 BY 1
               UNTIL PRIME-TBL-USAGE-FLAG (PRIME-INDEX) NOT = SPACE
                  OR PRIME-SUB-INDEX > MAX-SUBTOTAL-INDEXES
                  OR PRIME-TBL-SUB (PRIME-INDEX, PRIME-SUB-INDEX)
                              =  ZERO.

      ******************************************************************
       12245-SET-SUBTOTAL-FLAGS.
      ******************************************************************
           MOVE PRIME-TBL-SUB (PRIME-INDEX, PRIME-SUB-INDEX)
               TO  PRIME-WORK-INDEX.
           MOVE PRIME-SUBTOT-TBL-INDEX (PRIME-WORK-INDEX)
               TO  PRIME-WORK-INDEX.
           IF  PRIME-TBL-USAGE-FLAG (PRIME-WORK-INDEX) NOT = SPACE
               MOVE 'S' TO PRIME-TBL-USAGE-FLAG (PRIME-INDEX).

      ******************************************************************
       12250-WRITE-PXT-RECORD.
      ******************************************************************
           WRITE FD-PXT-TABLE-REC
               FROM  PRIME-TABLE-ENTRY (PRIME-INDEX).
           ADD 1 TO PXT-COUNT.
      /*****************************************************************
       12300-PROCESS-ORG-OTF.
      ******************************************************************
           IF  ORG-TABLE-ENTRY-1 (ORG-ID-INDEX, 1) NOT =  LOW-VALUES
               PERFORM 12320-FORMAT-OTF-HEADER-REC.
           PERFORM 12310-FORMAT-OTF-RECORD
               VARYING ORG-ENTRY-INDEX FROM 2 BY 1
               UNTIL  ORG-ENTRY-INDEX  >  MAX-ORG
                  OR  ORG-TABLE-ENTRY-1
                       (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                          =   LOW-VALUES.
      ******************************************************************
       12310-FORMAT-OTF-RECORD.
      ******************************************************************
           MOVE ORG-TBL-ROLLUP-KEY
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-ROLLUP-KEY.
           MOVE ORG-ENTRY-INDEX TO OTF-ENTRY-INDEX.
           MOVE ORG-TBL-ENTRY-MNEM
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-MNEMONIC.
           MOVE ORG-TBL-DESC (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                TO OTF-DESCRIPTION.
           MOVE ORG-TBL-KEY-LEVEL
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-LO-LEVEL.
           MOVE ORG-TBL-KEY-HI-LEVEL
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-HI-LEVEL.
           MOVE ORG-TBL-NEXT-TOT
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-NEXT-TOT.
           MOVE ORG-TBL-USAGE-FLAG
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-USAGE-FLAG.
      * ALWAYS PUT OUT A RECORD FOR SEARCH-KEY-1, SPACES OR NOT.
           MOVE ORG-TBL-SEARCH-KEY-1
                (ORG-ID-INDEX, ORG-ENTRY-INDEX) TO OTF-SEARCH-KEY.
           PERFORM 12330-WRITE-ORG-TABLE-REC.
           IF  ORG-TBL-SEARCH-KEY-2
             (ORG-ID-INDEX, ORG-ENTRY-INDEX)  NOT =  SPACES
               MOVE ORG-TBL-SEARCH-KEY-2
                    (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                       TO     OTF-SEARCH-KEY
               PERFORM 12330-WRITE-ORG-TABLE-REC.
           IF  ORG-TBL-SEARCH-KEY-3
             (ORG-ID-INDEX, ORG-ENTRY-INDEX)  NOT =  SPACES
               MOVE ORG-TBL-SEARCH-KEY-3
                    (ORG-ID-INDEX, ORG-ENTRY-INDEX)
                       TO     OTF-SEARCH-KEY
               PERFORM 12330-WRITE-ORG-TABLE-REC.
      /*****************************************************************
       12320-FORMAT-OTF-HEADER-REC.
      ******************************************************************
           MOVE SPACES TO OTF-RECORD.
           MOVE ORG-ID-INDEX TO ORG-HDR-INDEX.
           MOVE SAVE-ORG-HEADER (ORG-HDR-INDEX)
                   TO    IN-ORG-HEADER-RECORD.
           MOVE IN-ORG-ID TO OTF-ID.
           MOVE ORG-HDR-INDEX TO OTF-ID-INDEX.
           MOVE 1 TO OTF-ENTRY-INDEX.
           MOVE IN-ORG-LEVEL-MNEMONICS TO OTF-HDR-MNEMONICS.
           MOVE IN-ORG-DEFAULT-FAM TO OTF-DEFAULT-SEARCH-FAM.
           MOVE IN-ORG-TABLE-DESC TO OTF-HDR-DESCRIPTION.
           MOVE ORG-TOT-ENTRY (OTF-ID-INDEX) TO OTF-TOT-ENTRY-INDEX.
           PERFORM 12330-WRITE-ORG-TABLE-REC.
      ******************************************************************
       12330-WRITE-ORG-TABLE-REC.
      ******************************************************************
           WRITE FD-ORG-TABLE-FILE-REC  FROM  OTF-RECORD.
           ADD 1 TO OTF-COUNT.
      /*****************************************************************
       12400-PROCESS-REG-RTF.
      ******************************************************************
           IF  REG-TABLE-ENTRY (REG-ID-INDEX, 1) NOT =  LOW-VALUES
               PERFORM 12420-FORMAT-RTF-HEADER-REC.
           PERFORM 12410-FORMAT-RTF-RECORD
               VARYING REG-ENTRY-INDEX FROM 2 BY 1
               UNTIL  REG-ENTRY-INDEX  >  MAX-REG
                  OR  REG-TABLE-ENTRY
                       (REG-ID-INDEX, REG-ENTRY-INDEX)
                          =   LOW-VALUES.
      ******************************************************************
       12410-FORMAT-RTF-RECORD.
      ******************************************************************
           MOVE REG-TBL-ROLLUP-KEY
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-ROLLUP-KEY.
           SET RTF-ENTRY-INDEX TO REG-ENTRY-INDEX.
           MOVE REG-TBL-ENTRY-MNEM
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-MNEMONIC.
           MOVE REG-TBL-DESC (REG-ID-INDEX, REG-ENTRY-INDEX)
                TO RTF-DESCRIPTION.
           MOVE REG-TBL-SEARCH-KEY
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-SEARCH-KEY.
           MOVE REG-TBL-KEY-LEVEL
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-LO-LEVEL.
           MOVE REG-TBL-KEY-HI-LEVEL
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-HI-LEVEL.
           MOVE REG-TBL-NEXT-TOT
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-NEXT-TOT.
           MOVE REG-TBL-USAGE-FLAG
                (REG-ID-INDEX, REG-ENTRY-INDEX) TO RTF-USAGE-FLAG.
           PERFORM 12430-WRITE-REG-TABLE-REC.
      /*****************************************************************
       12420-FORMAT-RTF-HEADER-REC.
      ******************************************************************
           MOVE SPACES TO RTF-RECORD.
           SET REG-HDR-INDEX TO REG-ID-INDEX.
           MOVE SAVE-REG-HEADER (REG-HDR-INDEX)
                   TO    IN-REG-HEADER-RECORD.
           MOVE IN-REG-ID TO RTF-ID.
           MOVE REG-HDR-INDEX TO RTF-ID-INDEX.
           MOVE 1 TO RTF-ENTRY-INDEX.
           MOVE IN-REG-LEVEL-MNEMONICS TO RTF-HDR-MNEMONICS.
           MOVE IN-REG-TABLE-DESC TO RTF-HDR-DESCRIPTION.
           MOVE REG-TOT-ENTRY (RTF-ID-INDEX) TO RTF-TOT-ENTRY-INDEX.
           MOVE REG-HDR-FLAG-AREA (RTF-ID-INDEX)
                 TO RTF-HDR-FLAGS.
           PERFORM 12430-WRITE-REG-TABLE-REC.
      ******************************************************************
       12430-WRITE-REG-TABLE-REC.
      ******************************************************************
           WRITE FD-REG-TABLE-FILE-REC  FROM  RTF-RECORD.
           ADD 1 TO RTF-COUNT.
      /**************************************************************
       12500-COPY-TCM-RECS.
      ***************************************************************
           OPEN OUTPUT TBL-OF-CONT-FILE.
           MOVE SPACES TO SORT-FILE-STATUS.
           PERFORM 12510-RETURN-SD-TCM-REC.
           IF  NOT END-OF-SORT-FILE
               PERFORM 12520-WRITE-TCM-RECS
                   UNTIL END-OF-SORT-FILE.
           CLOSE TBL-OF-CONT-FILE.
           GO TO 12599-EXIT.
      ***************************************************************
       12510-RETURN-SD-TCM-REC.
      ***************************************************************
           RETURN SORT-FILE INTO TCM-RECORD
               AT END
                   MOVE 'EOF' TO SORT-FILE-STATUS.
      ***************************************************************
       12520-WRITE-TCM-RECS.
      ***************************************************************
           WRITE FD-TBL-OF-CONT-FILE-REC  FROM  TCM-RECORD.
           ADD 1 TO TCM-COUNT.
           PERFORM 12510-RETURN-SD-TCM-REC.
      ***************************************************************
       12599-EXIT.
      ***************************************************************
           EXIT.
      ***************************************************************
       12600-PROCESS-COUNTERS.
      ***************************************************************
      *
      *    DISPLAY '#---------------------------------------------#'.
      *    DISPLAY '# REPORT ID = R231-EDIT - FRS CONTROL TOTALS  #'.
      *    DISPLAY '#         GENERATED BY THE EDIT PROGRAM       #'.
      *    DISPLAY '#---------------------------------------------#'.
      *    DISPLAY '#                                             #'.
      *    DISPLAY
      *            '#           USER  CONTROLLED  TABLES          #'.
      *    DISPLAY
      *            '#           ----  ----------  ------          #'.
      *    DISPLAY
      *            '#                                             #'.
      *    MOVE DIST-COUNT TO CT.
      *    DISPLAY
      *        '#      DISTRIBUTEES = ' CT '                   #'.
      *    MOVE MAX-DISTRIBUTEES TO DSP.
      *    DISPLAY
      *         '#      (LIMIT IS ' DSP ')                       #'.
      *    MOVE BOOK-COUNT TO CT.
      *    DISPLAY
      *        '#      BOOKS IN TABLE = ' CT '                 #'.
      *    MOVE CTR-BDX TO CT.
      *    DISPLAY
      *        '#      BOOKS SELECTED = ' CT '                 #'.
      *    MOVE MAX-BDX TO DSP.
      *    DISPLAY
      *          '#      (LIMIT IS ' DSP ')                       #'.
      *    MOVE REPORT-COUNT TO CT.
      *    DISPLAY
      *        '#      REPORTS SELECTED = ' CT '               #'.
      *    MOVE MAX-RPT-WORK-ENTRIES TO DSP.
      *    DISPLAY
      *          '#      (LIMIT IS ' DSP ')                       #'.
      *    MOVE LINE-COUNT-CT TO CT.
      *    DISPLAY
      *        '#      LINE TABLES SELECTED = ' CT '           #'.
      *    MOVE MAX-LINE-TBL TO DSP.
      *    DISPLAY
      *         '#      (LIMIT IS ' DSP ')                       #'.
      *    MOVE COL-COUNT TO CT.
      *    DISPLAY
      *       '#      COLUMN TABLES SELECTED = ' CT '         #'.
      *    MOVE MAX-COL TO DSP.
      *    DISPLAY
      *         '#      (LIMIT IS ' DSP ')                       #'.
      *    DISPLAY
      *            '#      NUMBER OF ORGANIZATION TABLE ENTRIES:  #'.
      *    MOVE MAX-ORG TO DSP.
      *    DISPLAY
      *           '#      (LIMIT IS ' DSP ' PER TABLE)             #'.
      *    MOVE ORG-COUNT (1) TO CT.
      *    DISPLAY
      *        '#          ORG TABLE 1 = ' CT '                #'.
      *    MOVE ORG-COUNT (2) TO CT.
      *    DISPLAY
      *        '#          ORG TABLE 2 = ' CT '                #'.
      *    MOVE ORG-COUNT (3) TO CT.
      *    DISPLAY
      *        '#          ORG TABLE 3 = ' CT '                #'.
      *    MOVE ORG-COUNT (4) TO CT.
      *    DISPLAY
      *        '#          ORG TABLE 4 = ' CT '                #'.
      *    DISPLAY
      *            '#      NUMBER OF REGION TABLE ENTRIES:        #'.
      *    MOVE MAX-REG TO DSP.
      *    DISPLAY
      *          '#      (LIMIT IS ' DSP ' PER TABLE)             #'.
      *    MOVE REG-COUNT (1) TO CT.
      *    DISPLAY
      *        '#          REG TABLE 1 = ' CT '                #'.
      *    MOVE REG-COUNT (2) TO CT.
      *    DISPLAY
      *        '#          REG TABLE 2 = ' CT '                #'.
      *    MOVE REG-COUNT (3) TO CT.
      *    DISPLAY
      *        '#          REG TABLE 3 = ' CT '                #'.
      *    MOVE REG-COUNT (4) TO CT.
      *    DISPLAY
      *        '#          REG TABLE 4 = ' CT '                #'.
      *    MOVE REG-COUNT (5) TO CT.
      *    DISPLAY
      *        '#          REG TABLE 5 = ' CT '                #'.
      *    MOVE PRIME-COUNT TO CT.
      *    DISPLAY
      *        '#      PRIME TABLE ENTRIES = ' CT '            #'.
      *    MOVE MAX-PRIME TO DSP.
      *    DISPLAY
      *           '#      (LIMIT IS ' DSP ')                       #'.
      *    DISPLAY
      *            '#                                             #'.
      *    DISPLAY
      *            '#             INTERNAL  TABLE  COUNTS         #'.
      *    DISPLAY
      *            '#             --------  -----  ------         #'.
      *    DISPLAY
      *        '#                                             #'.
      *    DISPLAY
      *        '#         DTF RECORDS IN  = ' DTF-COUNT '           #'.
      *    DISPLAY
      *        '#         BDX RECORDS IN  = ' BDX-COUNT '           #'.
      *    DISPLAY
      *        '#         DBF RECORDS OUT = ' DBF-COUNT '           #'.
      *    DISPLAY
      *        '#         PXT RECORDS OUT = ' PXT-COUNT '           #'.
      *    DISPLAY
      *        '#         ORC RECORDS OUT = ' ORC-COUNT '           #'.
      *    DISPLAY
      *        '#         OTF RECORDS OUT = ' OTF-COUNT '           #'.
      *    DISPLAY
      *        '#         RTF RECORDS OUT = ' RTF-COUNT '           #'.
      *    DISPLAY
      *        '#         LDF RECORDS OUT = ' LDF-COUNT '           #'.
      *    DISPLAY
      *        '#         LCF RECORDS OUT = ' LCF-COUNT '           #'.
      *    DISPLAY
      *        '#         CBF RECORDS OUT = ' CBF-COUNT '           #'.
      *    DISPLAY
      *        '#         RDF RECORDS OUT = ' RDF-COUNT '           #'.
      *    DISPLAY
      *        '#         OCF RECORDS OUT = ' OCF-COUNT '           #'.
      *    DISPLAY
      *        '#         PCF RECORDS OUT = ' PCF-COUNT '           #'.
      *    DISPLAY
      *        '#         EXB RECORDS OUT = ' EXB-COUNT '           #'.
      *    DISPLAY
      *        '#         TCM RECORDS OUT = ' TCM-COUNT '           #'.
      *    DISPLAY
      *        '#         RCF RECORDS OUT = ' RCF-COUNT '           #'.
           OPEN OUTPUT CONTROL-TOTAL-FILE.
           WRITE FD-CONTROL-TOTAL-FILE-REC FROM CONTROL-TOTAL-RECORD.
           CLOSE CONTROL-TOTAL-FILE.
      /*****************************************************************
       99999-ABORT.
      ******************************************************************
           DISPLAY
              '@@ P231EDIT - PROGRAM ABORTING - CHECK SYSOUT @@'
                UPON CONSOLE.

           MOVE W9999-ERROR-MESSAGE-1 TO FD-ERROR-AREA
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.
           MOVE W9999-ERROR-MESSAGE-2 TO FD-ERROR-AREA
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.
           MOVE W9999-ERROR-MESSAGE-3 TO FD-ERROR-AREA
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.

           MOVE ALL '-' TO FD-ERROR-AREA.
           WRITE FD-ERRORS-REC AFTER ADVANCING 1 LINE.

           DISPLAY '###############################################'
           DISPLAY ' 9999-ABORT                 - RETURN CODE 0016 '
           DISPLAY '###############################################'

      *    MOVE 16 TO RETURN-CODE.
           GOBACK.
